ZMQ-FFI-1.19/0000755000000000000000000000000014463157020011215 5ustar rootrootZMQ-FFI-1.19/README0000644000000000000000000000057114463157020012100 0ustar rootrootThis archive contains the distribution ZMQ-FFI, version 1.19: version agnostic Perl bindings for zeromq using ffi This software is copyright (c) 2023 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. This README file was generated by Dist::Zilla::Plugin::Readme v6.012. ZMQ-FFI-1.19/Dockerfile0000644000000000000000000000713314463157020013213 0ustar rootrootFROM calid/perl-zmq-base:ubuntu as base ENV DEBIAN_FRONTEND=noninteractive ENV PREFIX=/root/.zmq-ffi/usr RUN apt-get update \ && apt-get install -y git g++ autoconf automake libtool-bin pkg-config \ uuid-dev tzdata locales \ && locale-gen fr_FR.utf8 && update-locale \ && apt-get clean WORKDIR /root/.zmq-ffi RUN git clone https://github.com/zeromq/zeromq2-x.git \ && cd zeromq2-x \ && ./autogen.sh \ && ./configure --prefix=$PREFIX/zeromq2-x --disable-static \ && make install \ && strip --strip-unneeded $PREFIX/zeromq2-x/lib/libzmq.so \ && git clean -dfx && git gc --aggressive --prune RUN git clone https://github.com/zeromq/zeromq3-x.git \ && cd zeromq3-x \ && ./autogen.sh \ && ./configure --prefix=$PREFIX/zeromq3-x --disable-static \ && make install \ && strip --strip-unneeded $PREFIX/zeromq3-x/lib/libzmq.so \ && git clean -dfx && git gc --aggressive --prune RUN git clone https://github.com/zeromq/zeromq4-1.git \ && cd zeromq4-1 \ && ./autogen.sh \ && ./configure --prefix=$PREFIX/zeromq4-1 --disable-static \ && make install \ && strip --strip-unneeded $PREFIX/zeromq4-1/lib/libzmq.so \ && git clean -dfx && git gc --aggressive --prune RUN git clone https://github.com/zeromq/zeromq4-x.git \ && cd zeromq4-x \ && ./autogen.sh \ && ./configure --prefix=$PREFIX/zeromq4-x --disable-static \ && make install \ && strip --strip-unneeded $PREFIX/zeromq4-x/lib/libzmq.so \ && git clean -dfx && git gc --aggressive --prune RUN git clone https://github.com/zeromq/libzmq.git \ && cd libzmq \ && ./autogen.sh \ && ./configure --prefix=$PREFIX/libzmq --disable-static \ && make install \ && strip --strip-unneeded $PREFIX/libzmq/lib/libzmq.so \ && git clean -dfx && git gc --aggressive --prune FROM base as zmq-base COPY scripts/print_zmq_msg_size.c zmq_msg_size/ RUN cd zmq_msg_size \ && \ gcc -I$PREFIX/zeromq2-x/include print_zmq_msg_size.c \ -o print_zeromq2-x_msg_size \ -Wl,-rpath=$PREFIX/zeromq2-x/lib -L$PREFIX/zeromq2-x/lib -lzmq \ && ./print_zeromq2-x_msg_size >> zmq_msg_sizes \ && \ gcc -I$PREFIX/zeromq3-x/include print_zmq_msg_size.c \ -o print_zeromq3-x_msg_size \ -Wl,-rpath=$PREFIX/zeromq3-x/lib -L$PREFIX/zeromq3-x/lib -lzmq \ && ./print_zeromq3-x_msg_size >> zmq_msg_sizes \ && \ gcc -I$PREFIX/zeromq4-1/include print_zmq_msg_size.c \ -o print_zeromq4-1_msg_size \ -Wl,-rpath=$PREFIX/zeromq4-1/lib -L$PREFIX/zeromq4-1/lib -lzmq \ && ./print_zeromq4-1_msg_size >> zmq_msg_sizes \ && \ gcc -I$PREFIX/zeromq4-x/include print_zmq_msg_size.c \ -o print_zeromq4-x_msg_size \ -Wl,-rpath=$PREFIX/zeromq4-x/lib -L$PREFIX/zeromq4-x/lib -lzmq \ && ./print_zeromq4-x_msg_size >> zmq_msg_sizes \ && \ gcc -I$PREFIX/libzmq/include print_zmq_msg_size.c \ -o print_libzmq_msg_size \ -Wl,-rpath=$PREFIX/libzmq/lib -L$PREFIX/libzmq/lib -lzmq \ && ./print_libzmq_msg_size >> zmq_msg_sizes FROM zmq-base as dzil-base RUN apt-get install -y libdist-zilla-perl libterm-ui-perl libanyevent-perl \ && apt-get clean FROM dzil-base as zmq-ffi-base COPY . /zmq-ffi/ RUN cd /zmq-ffi && dzil authordeps --missing | cpanm -v RUN cd /zmq-ffi && dzil listdeps --missing | cpanm -v && cpanm -v Sys::SigAction RUN apt-get -y purge gcc g++ autoconf automake libtool-bin pkg-config \ libssl-dev zlib1g-dev uuid-dev \ && apt -y autoremove \ && rm -r /var/lib/apt/lists/* ~/.cpanm /zmq-ffi /usr/local/share/man/* \ /usr/share/doc/* FROM scratch COPY --from=zmq-ffi-base / / ZMQ-FFI-1.19/lib/0000755000000000000000000000000014463157020011763 5ustar rootrootZMQ-FFI-1.19/lib/ZMQ/0000755000000000000000000000000014463157020012432 5ustar rootrootZMQ-FFI-1.19/lib/ZMQ/FFI.pm0000644000000000000000000003673414463157020013411 0ustar rootrootpackage ZMQ::FFI; $ZMQ::FFI::VERSION = '1.19'; # ABSTRACT: version agnostic Perl bindings for zeromq using ffi use strict; use warnings; use ZMQ::FFI::Util qw(zmq_soname zmq_version valid_soname); use Carp; use Import::Into; sub import { my ($pkg, @import_args) = @_; my $target = caller; ZMQ::FFI::Constants->import::into($target, @import_args); } sub new { my ($self, %args) = @_; if ($args{soname}) { unless ( valid_soname($args{soname}) ) { die "Failed to load '$args{soname}', is it on your loader path?"; } } else { $args{soname} = zmq_soname( die => 1 ); } my ($major, $minor) = zmq_version($args{soname}); if ($major == 2) { require ZMQ::FFI::ZMQ2::Context; return ZMQ::FFI::ZMQ2::Context->new(%args); } elsif ($major == 3) { require ZMQ::FFI::ZMQ3::Context; return ZMQ::FFI::ZMQ3::Context->new(%args); } else { if ($major == 4 and $minor == 0) { require ZMQ::FFI::ZMQ4::Context; return ZMQ::FFI::ZMQ4::Context->new(%args); } else { require ZMQ::FFI::ZMQ4_1::Context; return ZMQ::FFI::ZMQ4_1::Context->new(%args); } } } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI - version agnostic Perl bindings for zeromq using ffi =head1 VERSION version 1.19 =head1 SYNOPSIS #### send/recv #### use 5.012; use ZMQ::FFI qw(ZMQ_REQ ZMQ_REP); my $endpoint = "ipc://zmq-ffi-$$"; my $ctx = ZMQ::FFI->new(); my $s1 = $ctx->socket(ZMQ_REQ); $s1->connect($endpoint); my $s2 = $ctx->socket(ZMQ_REP); $s2->bind($endpoint); $s1->send('ohhai'); say $s2->recv(); # ohhai #### pub/sub #### use 5.012; use ZMQ::FFI qw(ZMQ_PUB ZMQ_SUB); use Time::HiRes q(usleep); my $endpoint = "ipc://zmq-ffi-$$"; my $ctx = ZMQ::FFI->new(); my $s = $ctx->socket(ZMQ_SUB); my $p = $ctx->socket(ZMQ_PUB); $s->connect($endpoint); $p->bind($endpoint); # all topics { $s->subscribe(''); until ($s->has_pollin) { # compensate for slow subscriber usleep 100_000; $p->send('ohhai'); } say $s->recv(); # ohhai $s->unsubscribe(''); } # specific topics { $s->subscribe('topic1'); $s->subscribe('topic2'); until ($s->has_pollin) { usleep 100_000; $p->send('topic1 ohhai'); $p->send('topic2 ohhai'); } while ($s->has_pollin) { say join ' ', $s->recv(); # topic1 ohhai # topic2 ohhai } } #### multipart #### use 5.012; use ZMQ::FFI qw(ZMQ_DEALER ZMQ_ROUTER); my $endpoint = "ipc://zmq-ffi-$$"; my $ctx = ZMQ::FFI->new(); my $d = $ctx->socket(ZMQ_DEALER); $d->set_identity('dealer'); my $r = $ctx->socket(ZMQ_ROUTER); $d->connect($endpoint); $r->bind($endpoint); $d->send_multipart([qw(ABC DEF GHI)]); say join ' ', $r->recv_multipart; # dealer ABC DEF GHI #### nonblocking #### use 5.012; use ZMQ::FFI qw(ZMQ_PUSH ZMQ_PULL); use AnyEvent; use EV; my $endpoint = "ipc://zmq-ffi-$$"; my $ctx = ZMQ::FFI->new(); my @messages = qw(foo bar baz); my $pull = $ctx->socket(ZMQ_PULL); $pull->bind($endpoint); my $fd = $pull->get_fd(); my $recv = 0; my $w = AE::io $fd, 0, sub { while ( $pull->has_pollin ) { say $pull->recv(); # foo, bar, baz $recv++; if ($recv == 3) { EV::break(); } } }; my $push = $ctx->socket(ZMQ_PUSH); $push->connect($endpoint); my $sent = 0; my $t; $t = AE::timer 0, .1, sub { $push->send($messages[$sent]); $sent++; if ($sent == 3) { undef $t; } }; EV::run(); #### specifying versions #### use ZMQ::FFI; # 2.x context my $ctx = ZMQ::FFI->new( soname => 'libzmq.so.1' ); my ($major, $minor, $patch) = $ctx->version; # 3.x context my $ctx = ZMQ::FFI->new( soname => 'libzmq.so.3' ); my ($major, $minor, $patch) = $ctx->version; =head1 DESCRIPTION ZMQ::FFI exposes a high level, transparent, OO interface to zeromq independent of the underlying libzmq version. Where semantics differ, it will dispatch to the appropriate backend for you. As it uses ffi, there is no dependency on XS or compilation. As of 1.00 ZMQ::FFI is implemented using L. This version has substantial performance improvements and you are encouraged to use 1.00 or newer. =head1 CONTEXT API =head2 new my $ctx = ZMQ::FFI->new(%options); returns a new context object, appropriate for the version of libzmq found on your system. It accepts the following optional attributes: =head3 options =over 4 =item threads zeromq thread pool size. Default: 1 =item max_sockets I= 3.x> max number of sockets allowed for context. Default: 1024 =item soname ZMQ::FFI->new( soname => '/path/to/libzmq.so' ); ZMQ::FFI->new( soname => 'libzmq.so.3' ); specify the libzmq library name to load. By default ZMQ::FFI will first try the generic soname for the system, then the soname for each version of zeromq (e.g. libzmq.so.3). C can also be the path to a particular libzmq so file It is technically possible to have multiple contexts of different versions in the same process, though the utility of doing such a thing is dubious =back =head2 version my ($major, $minor, $patch) = $ctx->version(); return the libzmq version as the list C<($major, $minor, $patch)> =head2 get I= 3.x> my $threads = $ctx->get(ZMQ_IO_THREADS) get a context option value =head2 set I= 3.x> $ctx->set(ZMQ_MAX_SOCKETS, 42) set a context option value =head2 socket my $socket = $ctx->socket(ZMQ_REQ) returns a socket of the specified type. See L below =head2 proxy $ctx->proxy($frontend, $backend); $ctx->proxy($frontend, $backend, $capture); sets up and runs a C. For zmq 2.x this will use a C device to simulate the proxy. The optional C<$capture> is only supported for zmq E= 3.x however =head2 device I $ctx->device($type, $frontend, $backend); sets up and runs a C with specified frontend and backend sockets =head2 destroy destroy the underlying zmq context. In general you shouldn't have to call this directly as it is called automatically for you when the object gets reaped See L below =head1 SOCKET API The following API is available on socket objects created by C<$ctx-Esocket>. For core attributes and functions, common across all versions of zeromq, convenience methods are provided. Otherwise, generic get/set methods are provided that will work independent of version. As attributes are constantly being added/removed from zeromq, it is unlikely the 'static' accessors will grow much beyond the current set. =head2 version my ($major, $minor, $patch) = $socket->version(); same as Context C above =head2 connect $socket->connect($endpoint); does socket connect on the specified endpoint =head2 disconnect I= 3.x> $socket->disconnect($endpoint); does socket disconnect on the specified endpoint =head2 bind $socket->bind($endpoint); does socket bind on the specified endpoint =head2 unbind I= 3.x> $socket->unbind($endpoint); does socket unbind on the specified endpoint =head2 get_linger, set_linger my $linger = $socket->get_linger(); $socket->set_linger($millis); get or set the socket linger period. Default: 0 (no linger) See L below =head2 get_identity, set_identity my $ident = $socket->get_identity(); $socket->set_identity($ident); get or set the socket identity for request/reply patterns =head2 get_fd my $fd = $socket->get_fd(); get the file descriptor associated with the socket =head2 get my $option_value = $socket->get($option_name, $option_type); my $linger = $socket->get(ZMQ_LINGER, 'int'); generic method to get the value for any socket option. C<$option_type> is the type associated with C<$option_value> in the zeromq API (C man page) =head2 set $socket->set($option_name, $option_type, $option_value); $socket->set(ZMQ_IDENTITY, 'binary', 'foo'); generic method to set the value for any socket option. C<$option_type> is the type associated with C<$option_value> in the zeromq API (C man page) =head2 subscribe $socket->subscribe($topic); add C<$topic> to the subscription list =head2 unsubscribe $socket->unsubscribe($topic); remove C<$topic> from the subscription list =head2 send $socket->send($msg); $socket->send($msg, $flags); sends a message using the optional flags =head2 send_multipart $socket->send($parts_aref); $socket->send($parts_aref, $flags); given an array ref of message parts, sends the multipart message using the optional flags. ZMQ_SNDMORE semantics are handled for you =head2 recv my $msg = $socket->recv(); my $msg = $socket->recv($flags); receives a message using the optional flags =head2 recv_multipart my @parts = $socket->recv_multipart(); my @parts = $socket->recv_multipart($flags); receives a multipart message, returning an array of parts. ZMQ_RCVMORE semantics are handled for you =head2 has_pollin, has_pollout while ( $socket->has_pollin ) { ... } checks ZMQ_EVENTS for ZMQ_POLLIN and ZMQ_POLLOUT respectively, and returns true/false depending on the state =head2 close close the underlying zmq socket. In general you shouldn't have to call this directly as it is called automatically for you when the object gets reaped See L below =head2 die_on_error $socket->die_on_error(0); $socket->die_on_error(1); controls whether error handling should be exceptional or not. This is set to true by default. See L below =head2 has_error returns true or false depending on whether the last socket operation had an error. This is really just an alias for C =head2 last_errno returns the system C set by the last socket operation, or 0 if there was no error =head2 last_strerror returns the human readable system error message associated with the socket C =head1 CLEANUP With respect to cleanup C follows either the L recommendations or the behavior of other zmq bindings. That is: =over 4 =item * it uses 0 linger by default (this is the default used by L and L) =item * during object destruction it will call close/destroy for you =item * it arranges the reference hierarchy such that sockets will be properly cleaned up before their associated contexts =item * it detects fork/thread situations and ensures sockets/contexts are only cleaned up in their originating process/thread =item * it guards against double closes/destroys =back Given the above you're probably better off letting C handle cleanup for you. But if for some reason you want to do explicit cleanup yourself you can. All the below will accomplish the same thing: # implicit cleanup { my $context = ZMQ::FFI->new(); my $socket = $ctx->socket($type); ... # close/destroy called in destructors at end of scope } # explicit cleanup $socket->close(); $context->destroy(); # ditto undef $socket; undef $context; Regarding C, you can always set this to a value you prefer if you don't like the default. Once set the new value will be used when the socket is subsequently closed (either implicitly or explicitly): $socket->set_linger(-1); # infinite linger # $context->destroy will block forever # (or until all pending messages have been sent) =head1 ERROR HANDLING By default, ZMQ::FFI checks the return codes of underlying zmq functions for you, and in the case of an error it will die with the human readable system error message. $ctx->socket(-1); # dies with 'zmq_socket: Invalid argument' Usually this is what you want, but not always. Some zmq operations can return errors that are not fatal and should be handled. For example using C with send/recv can return C and simply means try again, not die. For situations such as this you can turn off exceptional error handling by setting C to 0. It is then for you to check and manage any zmq errors by checking C: use Errno qw(EAGAIN); my $ctx = ZMQ::FFI->new(); my $s = $ctx->socket(ZMQ_DEALER); $s->bind('tcp://*:7200'); $s->die_on_error(0); # turn off exceptional error handling while (1) { my $msg = $s->recv(ZMQ_DONTWAIT); if ($s->last_errno == EAGAIN) { sleep 1; } elsif ($s->last_errno) { die $s->last_strerror; } else { warn "recvd: $msg"; last; } } $s->die_on_error(1); # turn back on exceptional error handling =head1 FFI VS XS PERFORMANCE ZMQ::FFI uses L on the backend. In addition to a friendly, usable interface, FFI::Platypus's killer feature is C. C makes it possible to bind ffi functions in memory as first class Perl xsubs. This results in dramatic performance gains and gives you the flexibility of ffi with performance approaching that of XS. Testing indicates FFI::Platypus xsubs are around 30% slower than "real" XS xsubs. That may sound like a lot, but to put it in perspective that means, for zeromq, the XS bindings can send 10 million messages 1-2 seconds faster than the ffi ones. If you really care about 1-2 seconds over 10 million messages you should be writing your solution in C anyways. An equivalent C implementation will be several I percent faster or more. Keep in mind also that the small speed bump you get using XS can easily be wiped out by crappy and poorly optimized Perl code. Now that Perl finally has a great ffi interface, it is hard to make the case to continue using XS. The slight speed bump just isn't worth giving up the convenience, flexibility, and portability of ffi. You can find the detailed performance results that informed this section at: L =head1 BUGS C is free as in beer in addition to being free as in speech. While I've done my best to ensure it's tasty, high quality beer, it probably isn't perfect. If you encounter problems, or otherwise see room for improvement, please open an issue (or even better a pull request!) on L =head1 SEE ALSO =over 4 =item * L =item * L =item * L =item * L =item * L =back =head1 CREDITS Thank you to the following for patches, bug reports, feedback, or suggestions: Dave Lambley, Graham Ollis, Klaus Ita, Marc Mims, Parth Gandhi, Pawel Pabian, Robert Hunter, Sergey KHripchenko, Slaven Rezic, Whitney Jackson, pipcet =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/0000755000000000000000000000000014463157020013036 5ustar rootrootZMQ-FFI-1.19/lib/ZMQ/FFI/Util.pm0000644000000000000000000000576514463157020014326 0ustar rootrootpackage ZMQ::FFI::Util; $ZMQ::FFI::Util::VERSION = '1.19'; # ABSTRACT: zmq convenience functions use strict; use warnings; use FFI::Platypus; use FFI::CheckLib qw(find_lib); use Carp; use Sub::Exporter -setup => { exports => [qw( zmq_soname zmq_version valid_soname current_tid )], }; sub zmq_soname { my %args = @_; my $die = $args{die}; my ($soname) = find_lib( lib => 'zmq', alien => 'Alien::ZMQ::latest', verify => sub { my($name, $libpath) = @_; return valid_soname($libpath); }, ); if ( !$soname && $die ) { croak qq(Could not load libzmq:\n), q(Is libzmq on your loader path?); } return $soname; } sub zmq_version { my ($soname) = @_; $soname //= zmq_soname(); return unless $soname; my $ffi = FFI::Platypus->new( lib => $soname, ignore_not_found => 1 ); my $zmq_version = $ffi->function( 'zmq_version', ['int*', 'int*', 'int*'], 'void' ); unless (defined $zmq_version) { croak "Could not find zmq_version in '$soname'\n" . "Is '$soname' on your loader path?"; } my ($major, $minor, $patch); $zmq_version->call(\$major, \$minor, \$patch); return $major, $minor, $patch; } sub valid_soname { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname, ignore_not_found => 1 ); my $zmq_version = $ffi->function( 'zmq_version', ['int*', 'int*', 'int*'], 'void' ); return defined $zmq_version; } sub current_tid { if (eval 'use threads; 1') { require threads; threads->import(); return threads->tid; } else { return -1; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::Util - zmq convenience functions =head1 VERSION version 1.19 =head1 SYNOPSIS use ZMQ::FFI::Util q(zmq_soname zmq_version) my $soname = zmq_soname(); my ($major, $minor, $patch) = zmq_version($soname); =head1 FUNCTIONS =head2 zmq_soname([die => 0|1]) Tries to load C by looking for platform-specific shared library file using L with a fallback to L. Returns the name of the first one that was successful or undef. If you would prefer exceptional behavior pass C 1> =head2 ($major, $minor, $patch) = zmq_version([$soname]) return the libzmq version as the list C<($major, $minor, $patch)>. C<$soname> can either be a filename available in the ld cache or the path to a library file. If C<$soname> is not specified it is resolved using C above If C<$soname> cannot be resolved undef is returned =head1 SEE ALSO =over 4 =item * L =back =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ4_1/0000755000000000000000000000000014463157020014011 5ustar rootrootZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ4_1/Socket.pm0000644000000000000000000003074014463157020015603 0ustar rootroot# # Module Generated by Template::Tiny on Fri Aug 4 11:16:27 UTC 2023 # package ZMQ::FFI::ZMQ4_1::Socket; $ZMQ::FFI::ZMQ4_1::Socket::VERSION = '1.19'; use FFI::Platypus; use FFI::Platypus::Buffer; use FFI::Platypus::Memory qw(malloc free memcpy); use Carp qw(croak carp); use Try::Tiny; use ZMQ::FFI::ZMQ4_1::Raw; use ZMQ::FFI::Custom::Raw; use ZMQ::FFI::Constants qw(:all); use ZMQ::FFI::Util qw(current_tid); 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) { ZMQ::FFI::Custom::Raw::load($self->soname); ZMQ::FFI::ZMQ4_1::Raw::load($self->soname); $FFI_LOADED = 1; } # 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); } sub connect { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->connect($endpoint)'; } $self->check_error( 'zmq_connect', zmq_connect($self->socket_ptr, $endpoint) ); } sub disconnect { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->disconnect($endpoint)'; } $self->check_error( 'zmq_disconnect', zmq_disconnect($self->socket_ptr, $endpoint) ); } sub bind { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->bind($endpoint)' } $self->check_error( 'zmq_bind', zmq_bind($self->socket_ptr, $endpoint) ); } sub unbind { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->unbind($endpoint)'; } $self->check_error( 'zmq_unbind', zmq_unbind($self->socket_ptr, $endpoint) ); } sub send { # 0: self # 1: data # 2: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $_[0]->{last_errno} = 0; use bytes; my $length = length($_[1]); no bytes; if ( -1 == zmq_send($_[0]->socket_ptr, $_[1], $length, ($_[2] // 0)) ) { $_[0]->{last_errno} = zmq_errno(); if ($_[0]->die_on_error) { $_[0]->fatal('zmq_send'); } return; } } sub send_multipart { # 0: self # 1: partsref # 2: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } 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 { # 0: self # 1: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $_[0]->{last_errno} = 0; # retval = msg size my $retval = zmq_msg_recv($_[0]->{"_zmq_msg_t"}, $_[0]->socket_ptr, $_[1] // 0); if ( $retval == -1 ) { $_[0]->{last_errno} = zmq_errno(); if ($_[0]->die_on_error) { $_[0]->fatal('zmq_msg_recv'); } return; } if ($retval) { return buffer_to_scalar(zmq_msg_data($_[0]->{"_zmq_msg_t"}), $retval); } return ''; } sub recv_multipart { # 0: self # 1: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } 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 { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_FD, 'int'); } sub get_linger { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_LINGER, 'int'); } sub set_linger { my ($self, $linger) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_LINGER, 'int', $linger); } sub get_identity { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_IDENTITY, 'binary'); } sub set_identity { my ($self, $id) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_IDENTITY, 'binary', $id); } sub subscribe { my ($self, $topic) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_SUBSCRIBE, 'binary', $topic); } sub unsubscribe { my ($self, $topic) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_UNSUBSCRIBE, 'binary', $topic); } sub has_pollin { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLIN; } sub has_pollout { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLOUT; } sub get { my ($self, $opt, $opt_type) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } my $optval; my $optval_len; for ($opt_type) { if ($_ =~ /^(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_ptr, $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); } } elsif ($_ eq 'int') { $optval_len = $self->sockopt_sizes->{'int'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } elsif ($_ eq 'int64_t') { $optval_len = $self->sockopt_sizes->{'sint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } elsif ($_ eq 'uint64_t') { $optval_len = $self->sockopt_sizes->{'uint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_uint64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } else { croak "unknown type $opt_type"; } } if ($optval ne '') { return $optval; } return; } sub set { my ($self, $opt, $opt_type, $optval) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } for ($opt_type) { if ($_ =~ /^(binary|string)$/) { my ($optval_ptr, $optval_len) = scalar_to_buffer($optval); $self->check_error( 'zmq_setsockopt', zmq_setsockopt_binary( $self->socket_ptr, $opt, $optval_ptr, $optval_len ) ); } elsif ($_ eq 'int') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'int'} ) ); } elsif ($_ eq 'int64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'sint64'} ) ); } elsif ($_ eq 'uint64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_uint64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'uint64'} ) ); } else { croak "unknown type $opt_type"; } } return; } sub close { my ($self) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } # don't try to cleanup socket cloned from another thread return unless $self->_tid == current_tid(); # don't try to cleanup socket copied from another process (fork) return unless $self->_pid == $$; $self->check_error( 'zmq_msg_close', zmq_msg_close($self->_zmq_msg_t) ); $self->check_error( 'zmq_close', zmq_close($self->socket_ptr) ); $self->socket_ptr(-1); } sub monitor { my ($self, $endpoint, $event) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->monitor($endpoint, $events)'; } $self->check_error( 'zmq_socket_monitor', zmq_socket_monitor($self->socket_ptr, $endpoint, $event) ); } sub recv_event { my ($self, $flags) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } my ($event, $endpoint) = $self->recv_multipart($flags); my ($id, $value) = unpack('S L', $event); return ($id, $value, $endpoint); } sub DEMOLISH { my ($self) = @_; # remove ourselves from the context object so that we dont leak $self->context->_remove_socket($self) if (defined $self->context); return if $self->socket_ptr == -1; $self->close(); } 1; # vim:ft=perl __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ4_1::Socket =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ4_1/Context.pm0000644000000000000000000001224014463157020015772 0ustar rootroot# # Module Generated by Template::Tiny on Fri Aug 4 11:16:27 UTC 2023 # package ZMQ::FFI::ZMQ4_1::Context; $ZMQ::FFI::ZMQ4_1::Context::VERSION = '1.19'; use FFI::Platypus; use ZMQ::FFI::Util qw(zmq_soname current_tid); use ZMQ::FFI::Constants qw(:all); use ZMQ::FFI::ZMQ4_1::Socket; use ZMQ::FFI::ZMQ4_1::Raw; use ZMQ::FFI::Custom::Raw; use Try::Tiny; use Scalar::Util qw(weaken); use FFI::Platypus::Memory qw(free malloc); use FFI::Platypus::Buffer qw(buffer_to_scalar); use Moo; use namespace::clean; with qw( ZMQ::FFI::ContextRole ZMQ::FFI::ErrorHelper ZMQ::FFI::Versioner ); my $FFI_LOADED; sub BUILD { my ($self) = @_; unless ($FFI_LOADED) { ZMQ::FFI::Custom::Raw::load($self->soname); ZMQ::FFI::ZMQ4_1::Raw::load($self->soname); $FFI_LOADED = 1; } $self->init() } sub init { my ($self) = @_; try { $self->context_ptr( zmq_ctx_new() ); $self->check_null('zmq_ctx_new', $self->context_ptr); } catch { $self->context_ptr(-1); die $_; }; if ( $self->has_threads ) { $self->set(ZMQ_IO_THREADS, $self->threads); } if ( $self->has_max_sockets ) { $self->set(ZMQ_MAX_SOCKETS, $self->max_sockets); } } sub get { my ($self, $option) = @_; my $option_val = zmq_ctx_get($self->context_ptr, $option); $self->check_error('zmq_ctx_get', $option_val); return $option_val; } sub set { my ($self, $option, $option_val) = @_; $self->check_error( 'zmq_ctx_set', zmq_ctx_set($self->context_ptr, $option, $option_val) ); } sub socket { my ($self, $type) = @_; my $socket; try { my $socket_ptr = zmq_socket($self->context_ptr, $type); $self->check_null('zmq_socket', $socket_ptr); $socket = ZMQ::FFI::ZMQ4_1::Socket->new( socket_ptr => $socket_ptr, context => $self, # this will become a weak ref type => $type, soname => $self->soname, ); } catch { die $_; }; # add the socket to the socket hash $self->_add_socket($socket); return $socket; } sub proxy { my ($self, $frontend, $backend, $capture) = @_; $self->check_error( 'zmq_proxy', zmq_proxy( $frontend->socket_ptr, $backend->socket_ptr, defined $capture ? $capture->socket_ptr : undef, ) ); } sub device { my ($self, $type, $frontend, $backend) = @_; $self->bad_version( $self->verstr, "zmq_device not available in zmq >= 3.x", ); } sub destroy { my ($self) = @_; return if $self->context_ptr == -1; # don't try to cleanup context cloned from another thread return unless $self->_tid == current_tid(); # don't try to cleanup context copied from another process (fork) return unless $self->_pid == $$; $self->check_error( 'zmq_ctx_term', zmq_ctx_term($self->context_ptr) ); $self->context_ptr(-1); } sub curve_keypair { my ($self) = @_; my $public_key_buf = malloc(41); my $secret_key_buf = malloc(41); $self->check_error( 'zmq_curve_keypair', zmq_curve_keypair($public_key_buf, $secret_key_buf) ); my $public_key = buffer_to_scalar($public_key_buf, 41); my $secret_key = buffer_to_scalar($secret_key_buf, 41); free($public_key_buf); free($secret_key_buf); return ($public_key, $secret_key); } sub z85_encode { my ($self, $data) = @_; my $dest_buf = malloc(41); my $checked_data = substr($data, 0, 32); $self->check_null( 'zmq_z85_encode', zmq_z85_encode( $dest_buf, $checked_data, length($checked_data) ) ); my $dest = buffer_to_scalar($dest_buf, 41); free($dest_buf); return $dest; } sub z85_decode { my ($self, $string) = @_; my $dest_buf = malloc(32); $self->check_null( 'zmq_z86_decode', zmq_z85_decode($dest_buf, $string) ); my $dest = buffer_to_scalar($dest_buf, 32); free($dest_buf); return $dest; } sub has_capability { my ($self, $capability) = @_; return zmq_has($capability); } sub _add_socket { my ($self, $socket) = @_; weaken($self->sockets->{$socket} = $socket); } sub _remove_socket { my ($self, $socket) = @_; delete($self->sockets->{$socket}); } sub DEMOLISH { my ($self) = @_; return if $self->context_ptr == -1; # check defined to guard against # undef objects during global destruction if (defined $self->sockets) { for my $socket_k (keys %{$self->sockets}) { my $socket = $self->_remove_socket($socket_k); $socket->close() if defined $socket && $socket->socket_ptr != -1; } } $self->destroy(); } 1; # vim:ft=perl __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ4_1::Context =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ4_1/Raw.pm0000644000000000000000000001172014463157020015101 0ustar rootrootpackage ZMQ::FFI::ZMQ4_1::Raw; $ZMQ::FFI::ZMQ4_1::Raw::VERSION = '1.19'; use FFI::Platypus; sub load { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname // 'libzmq.so' ); my $target = caller; $ffi->attach( # void *zmq_ctx_new() ['zmq_ctx_new' => "${target}::zmq_ctx_new"] => [] => 'pointer' ); $ffi->attach( # int zmq_ctx_get(void *context, int option_name) ['zmq_ctx_get' => "${target}::zmq_ctx_get"] => ['pointer', 'int'] => 'int' ); $ffi->attach( # int zmq_ctx_set(void *context, int option_name, int option_value) ['zmq_ctx_set' => "${target}::zmq_ctx_set"] => ['pointer', 'int', 'int'] => 'int' ); $ffi->attach( # void *zmq_socket(void *context, int type) ['zmq_socket' => "${target}::zmq_socket"] => ['pointer', 'int'] => 'pointer' ); $ffi->attach( # int zmq_proxy(const void *front, const void *back, const void *cap) ['zmq_proxy' => "${target}::zmq_proxy"] => ['pointer', 'pointer', 'pointer'] => 'int' ); $ffi->attach( # int zmq_ctx_term (void *context) ['zmq_ctx_term' => "${target}::zmq_ctx_term"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_send(void *socket, void *buf, size_t len, int flags) ['zmq_send' => "${target}::zmq_send"] => ['pointer', 'string', 'size_t', 'int'] => 'int' ); $ffi->attach( # int zmq_msg_recv(zmq_msg_t *msg, void *socket, int flags) ['zmq_msg_recv' => "${target}::zmq_msg_recv"] => ['pointer', 'pointer', 'int'] => 'int' ); $ffi->attach( # int zmq_unbind(void *socket, const char *endpoint) ['zmq_unbind' => "${target}::zmq_unbind"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_disconnect(void *socket, const char *endpoint) ['zmq_disconnect' => "${target}::zmq_disconnect"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_connect(void *socket, const char *endpoint) ['zmq_connect' => "${target}::zmq_connect"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_bind(void *socket, const char *endpoint) ['zmq_bind' => "${target}::zmq_bind"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_msg_init(zmq_msg_t *msg) ['zmq_msg_init' => "${target}::zmq_msg_init"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_msg_init_size(zmq_msg_t *msg, size_t size) ['zmq_msg_init_size' => "${target}::zmq_msg_init_size"] => ['pointer', 'int'] => 'int' ); $ffi->attach( # size_t zmq_msg_size(zmq_msg_t *msg) ['zmq_msg_size' => "${target}::zmq_msg_size"] => ['pointer'] => 'int' ); $ffi->attach( # void *zmq_msg_data(zmq_msg_t *msg) ['zmq_msg_data' => "${target}::zmq_msg_data"] => ['pointer'] => 'pointer' ); $ffi->attach( # int zmq_msg_close(zmq_msg_t *msg) ['zmq_msg_close' => "${target}::zmq_msg_close"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_close(void *socket) ['zmq_close' => "${target}::zmq_close"] => ['pointer'] => 'int' ); $ffi->attach( # const char *zmq_strerror(int errnum) ['zmq_strerror' => "${target}::zmq_strerror"] => ['int'] => 'string' ); $ffi->attach( # int zmq_errno(void) ['zmq_errno' => "${target}::zmq_errno"] => [] => 'int' ); $ffi->attach( # int zmq_curve_keypair (char *z85_public_key, char *z85_secret_key); ['zmq_curve_keypair' => "${target}::zmq_curve_keypair"] => ['opaque', 'opaque'] => 'int' ); $ffi->attach( # char *zmq_z85_encode (char *dest, const uint8_t *data, size_t size); ['zmq_z85_encode' => "${target}::zmq_z85_encode"] => ['opaque', 'string', 'size_t'] => 'pointer' ); $ffi->attach( # uint8_t *zmq_z85_decode (uint8_t *dest, const char *string); ['zmq_z85_decode' => "${target}::zmq_z85_decode"] => ['opaque', 'string'] => 'pointer' ); $ffi->attach( # int zmq_has (const char *capability); ['zmq_has' => "${target}::zmq_has"] => ['string'] => 'int' ); $ffi->attach( # int zmq_socket_monitor (void *socket, char *endpoint, int events); ['zmq_socket_monitor' => "${target}::zmq_socket_monitor"] => ['pointer', 'string', 'int'] => 'int' ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ4_1::Raw =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ContextRole.pm0000644000000000000000000000245714463157020015652 0ustar rootrootpackage ZMQ::FFI::ContextRole; $ZMQ::FFI::ContextRole::VERSION = '1.19'; use Moo::Role; use ZMQ::FFI::Util qw(current_tid); # real underlying zmq context pointer has context_ptr => ( is => 'rw', default => -1, ); # used to make sure we handle fork situations correctly has _pid => ( is => 'ro', default => sub { $$ }, ); # used to make sure we handle thread situations correctly has _tid => ( is => 'ro', default => sub { current_tid() }, ); has soname => ( is => 'ro', required => 1, ); has threads => ( is => 'ro', predicate => 'has_threads', ); has max_sockets => ( is => 'ro', predicate => 'has_max_sockets', ); has sockets => ( is => 'rw', lazy => 1, default => sub { {} }, ); requires qw( init get set socket proxy device destroy curve_keypair z85_encode z85_decode has_capability ); 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ContextRole =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ4/0000755000000000000000000000000014463157020013571 5ustar rootrootZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ4/Socket.pm0000644000000000000000000003072614463157020015367 0ustar rootroot# # Module Generated by Template::Tiny on Fri Aug 4 11:16:27 UTC 2023 # package ZMQ::FFI::ZMQ4::Socket; $ZMQ::FFI::ZMQ4::Socket::VERSION = '1.19'; use FFI::Platypus; use FFI::Platypus::Buffer; use FFI::Platypus::Memory qw(malloc free memcpy); use Carp qw(croak carp); use Try::Tiny; use ZMQ::FFI::ZMQ4::Raw; use ZMQ::FFI::Custom::Raw; use ZMQ::FFI::Constants qw(:all); use ZMQ::FFI::Util qw(current_tid); 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) { ZMQ::FFI::Custom::Raw::load($self->soname); ZMQ::FFI::ZMQ4::Raw::load($self->soname); $FFI_LOADED = 1; } # 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); } sub connect { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->connect($endpoint)'; } $self->check_error( 'zmq_connect', zmq_connect($self->socket_ptr, $endpoint) ); } sub disconnect { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->disconnect($endpoint)'; } $self->check_error( 'zmq_disconnect', zmq_disconnect($self->socket_ptr, $endpoint) ); } sub bind { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->bind($endpoint)' } $self->check_error( 'zmq_bind', zmq_bind($self->socket_ptr, $endpoint) ); } sub unbind { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->unbind($endpoint)'; } $self->check_error( 'zmq_unbind', zmq_unbind($self->socket_ptr, $endpoint) ); } sub send { # 0: self # 1: data # 2: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $_[0]->{last_errno} = 0; use bytes; my $length = length($_[1]); no bytes; if ( -1 == zmq_send($_[0]->socket_ptr, $_[1], $length, ($_[2] // 0)) ) { $_[0]->{last_errno} = zmq_errno(); if ($_[0]->die_on_error) { $_[0]->fatal('zmq_send'); } return; } } sub send_multipart { # 0: self # 1: partsref # 2: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } 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 { # 0: self # 1: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $_[0]->{last_errno} = 0; # retval = msg size my $retval = zmq_msg_recv($_[0]->{"_zmq_msg_t"}, $_[0]->socket_ptr, $_[1] // 0); if ( $retval == -1 ) { $_[0]->{last_errno} = zmq_errno(); if ($_[0]->die_on_error) { $_[0]->fatal('zmq_msg_recv'); } return; } if ($retval) { return buffer_to_scalar(zmq_msg_data($_[0]->{"_zmq_msg_t"}), $retval); } return ''; } sub recv_multipart { # 0: self # 1: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } 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 { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_FD, 'int'); } sub get_linger { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_LINGER, 'int'); } sub set_linger { my ($self, $linger) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_LINGER, 'int', $linger); } sub get_identity { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_IDENTITY, 'binary'); } sub set_identity { my ($self, $id) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_IDENTITY, 'binary', $id); } sub subscribe { my ($self, $topic) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_SUBSCRIBE, 'binary', $topic); } sub unsubscribe { my ($self, $topic) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_UNSUBSCRIBE, 'binary', $topic); } sub has_pollin { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLIN; } sub has_pollout { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLOUT; } sub get { my ($self, $opt, $opt_type) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } my $optval; my $optval_len; for ($opt_type) { if ($_ =~ /^(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_ptr, $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); } } elsif ($_ eq 'int') { $optval_len = $self->sockopt_sizes->{'int'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } elsif ($_ eq 'int64_t') { $optval_len = $self->sockopt_sizes->{'sint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } elsif ($_ eq 'uint64_t') { $optval_len = $self->sockopt_sizes->{'uint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_uint64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } else { croak "unknown type $opt_type"; } } if ($optval ne '') { return $optval; } return; } sub set { my ($self, $opt, $opt_type, $optval) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } for ($opt_type) { if ($_ =~ /^(binary|string)$/) { my ($optval_ptr, $optval_len) = scalar_to_buffer($optval); $self->check_error( 'zmq_setsockopt', zmq_setsockopt_binary( $self->socket_ptr, $opt, $optval_ptr, $optval_len ) ); } elsif ($_ eq 'int') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'int'} ) ); } elsif ($_ eq 'int64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'sint64'} ) ); } elsif ($_ eq 'uint64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_uint64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'uint64'} ) ); } else { croak "unknown type $opt_type"; } } return; } sub close { my ($self) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } # don't try to cleanup socket cloned from another thread return unless $self->_tid == current_tid(); # don't try to cleanup socket copied from another process (fork) return unless $self->_pid == $$; $self->check_error( 'zmq_msg_close', zmq_msg_close($self->_zmq_msg_t) ); $self->check_error( 'zmq_close', zmq_close($self->socket_ptr) ); $self->socket_ptr(-1); } sub monitor { my ($self, $endpoint, $event) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->monitor($endpoint, $events)'; } $self->check_error( 'zmq_socket_monitor', zmq_socket_monitor($self->socket_ptr, $endpoint, $event) ); } sub recv_event { my ($self, $flags) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } my ($event, $endpoint) = $self->recv_multipart($flags); my ($id, $value) = unpack('S L', $event); return ($id, $value, $endpoint); } sub DEMOLISH { my ($self) = @_; # remove ourselves from the context object so that we dont leak $self->context->_remove_socket($self) if (defined $self->context); return if $self->socket_ptr == -1; $self->close(); } 1; # vim:ft=perl __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ4::Socket =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ4/Context.pm0000644000000000000000000001231514463157020015555 0ustar rootroot# # Module Generated by Template::Tiny on Fri Aug 4 11:16:27 UTC 2023 # package ZMQ::FFI::ZMQ4::Context; $ZMQ::FFI::ZMQ4::Context::VERSION = '1.19'; use FFI::Platypus; use ZMQ::FFI::Util qw(zmq_soname current_tid); use ZMQ::FFI::Constants qw(:all); use ZMQ::FFI::ZMQ4::Socket; use ZMQ::FFI::ZMQ4::Raw; use ZMQ::FFI::Custom::Raw; use Try::Tiny; use Scalar::Util qw(weaken); use FFI::Platypus::Memory qw(free malloc); use FFI::Platypus::Buffer qw(buffer_to_scalar); use Moo; use namespace::clean; with qw( ZMQ::FFI::ContextRole ZMQ::FFI::ErrorHelper ZMQ::FFI::Versioner ); my $FFI_LOADED; sub BUILD { my ($self) = @_; unless ($FFI_LOADED) { ZMQ::FFI::Custom::Raw::load($self->soname); ZMQ::FFI::ZMQ4::Raw::load($self->soname); $FFI_LOADED = 1; } $self->init() } sub init { my ($self) = @_; try { $self->context_ptr( zmq_ctx_new() ); $self->check_null('zmq_ctx_new', $self->context_ptr); } catch { $self->context_ptr(-1); die $_; }; if ( $self->has_threads ) { $self->set(ZMQ_IO_THREADS, $self->threads); } if ( $self->has_max_sockets ) { $self->set(ZMQ_MAX_SOCKETS, $self->max_sockets); } } sub get { my ($self, $option) = @_; my $option_val = zmq_ctx_get($self->context_ptr, $option); $self->check_error('zmq_ctx_get', $option_val); return $option_val; } sub set { my ($self, $option, $option_val) = @_; $self->check_error( 'zmq_ctx_set', zmq_ctx_set($self->context_ptr, $option, $option_val) ); } sub socket { my ($self, $type) = @_; my $socket; try { my $socket_ptr = zmq_socket($self->context_ptr, $type); $self->check_null('zmq_socket', $socket_ptr); $socket = ZMQ::FFI::ZMQ4::Socket->new( socket_ptr => $socket_ptr, context => $self, # this will become a weak ref type => $type, soname => $self->soname, ); } catch { die $_; }; # add the socket to the socket hash $self->_add_socket($socket); return $socket; } sub proxy { my ($self, $frontend, $backend, $capture) = @_; $self->check_error( 'zmq_proxy', zmq_proxy( $frontend->socket_ptr, $backend->socket_ptr, defined $capture ? $capture->socket_ptr : undef, ) ); } sub device { my ($self, $type, $frontend, $backend) = @_; $self->bad_version( $self->verstr, "zmq_device not available in zmq >= 3.x", ); } sub destroy { my ($self) = @_; return if $self->context_ptr == -1; # don't try to cleanup context cloned from another thread return unless $self->_tid == current_tid(); # don't try to cleanup context copied from another process (fork) return unless $self->_pid == $$; $self->check_error( 'zmq_ctx_term', zmq_ctx_term($self->context_ptr) ); $self->context_ptr(-1); } sub curve_keypair { my ($self) = @_; my $public_key_buf = malloc(41); my $secret_key_buf = malloc(41); $self->check_error( 'zmq_curve_keypair', zmq_curve_keypair($public_key_buf, $secret_key_buf) ); my $public_key = buffer_to_scalar($public_key_buf, 41); my $secret_key = buffer_to_scalar($secret_key_buf, 41); free($public_key_buf); free($secret_key_buf); return ($public_key, $secret_key); } sub z85_encode { my ($self, $data) = @_; my $dest_buf = malloc(41); my $checked_data = substr($data, 0, 32); $self->check_null( 'zmq_z85_encode', zmq_z85_encode( $dest_buf, $checked_data, length($checked_data) ) ); my $dest = buffer_to_scalar($dest_buf, 41); free($dest_buf); return $dest; } sub z85_decode { my ($self, $string) = @_; my $dest_buf = malloc(32); $self->check_null( 'zmq_z86_decode', zmq_z85_decode($dest_buf, $string) ); my $dest = buffer_to_scalar($dest_buf, 32); free($dest_buf); return $dest; } sub has_capability { my ($self) = @_; $self->bad_version( $self->verstr, "has_capability not available in < zmq 4.1" ); } sub _add_socket { my ($self, $socket) = @_; weaken($self->sockets->{$socket} = $socket); } sub _remove_socket { my ($self, $socket) = @_; delete($self->sockets->{$socket}); } sub DEMOLISH { my ($self) = @_; return if $self->context_ptr == -1; # check defined to guard against # undef objects during global destruction if (defined $self->sockets) { for my $socket_k (keys %{$self->sockets}) { my $socket = $self->_remove_socket($socket_k); $socket->close() if defined $socket && $socket->socket_ptr != -1; } } $self->destroy(); } 1; # vim:ft=perl __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ4::Context =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ4/Raw.pm0000644000000000000000000001146114463157020014663 0ustar rootrootpackage ZMQ::FFI::ZMQ4::Raw; $ZMQ::FFI::ZMQ4::Raw::VERSION = '1.19'; use FFI::Platypus; sub load { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname // 'libzmq.so' ); my $target = caller; $ffi->attach( # void *zmq_ctx_new() ['zmq_ctx_new' => "${target}::zmq_ctx_new"] => [] => 'pointer' ); $ffi->attach( # int zmq_ctx_get(void *context, int option_name) ['zmq_ctx_get' => "${target}::zmq_ctx_get"] => ['pointer', 'int'] => 'int' ); $ffi->attach( # int zmq_ctx_set(void *context, int option_name, int option_value) ['zmq_ctx_set' => "${target}::zmq_ctx_set"] => ['pointer', 'int', 'int'] => 'int' ); $ffi->attach( # void *zmq_socket(void *context, int type) ['zmq_socket' => "${target}::zmq_socket"] => ['pointer', 'int'] => 'pointer' ); $ffi->attach( # int zmq_proxy(const void *front, const void *back, const void *cap) ['zmq_proxy' => "${target}::zmq_proxy"] => ['pointer', 'pointer', 'pointer'] => 'int' ); $ffi->attach( # int zmq_ctx_term (void *context) ['zmq_ctx_term' => "${target}::zmq_ctx_term"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_send(void *socket, void *buf, size_t len, int flags) ['zmq_send' => "${target}::zmq_send"] => ['pointer', 'string', 'size_t', 'int'] => 'int' ); $ffi->attach( # int zmq_msg_recv(zmq_msg_t *msg, void *socket, int flags) ['zmq_msg_recv' => "${target}::zmq_msg_recv"] => ['pointer', 'pointer', 'int'] => 'int' ); $ffi->attach( # int zmq_unbind(void *socket, const char *endpoint) ['zmq_unbind' => "${target}::zmq_unbind"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_disconnect(void *socket, const char *endpoint) ['zmq_disconnect' => "${target}::zmq_disconnect"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_connect(void *socket, const char *endpoint) ['zmq_connect' => "${target}::zmq_connect"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_bind(void *socket, const char *endpoint) ['zmq_bind' => "${target}::zmq_bind"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_msg_init(zmq_msg_t *msg) ['zmq_msg_init' => "${target}::zmq_msg_init"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_msg_init_size(zmq_msg_t *msg, size_t size) ['zmq_msg_init_size' => "${target}::zmq_msg_init_size"] => ['pointer', 'int'] => 'int' ); $ffi->attach( # size_t zmq_msg_size(zmq_msg_t *msg) ['zmq_msg_size' => "${target}::zmq_msg_size"] => ['pointer'] => 'int' ); $ffi->attach( # void *zmq_msg_data(zmq_msg_t *msg) ['zmq_msg_data' => "${target}::zmq_msg_data"] => ['pointer'] => 'pointer' ); $ffi->attach( # int zmq_msg_close(zmq_msg_t *msg) ['zmq_msg_close' => "${target}::zmq_msg_close"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_close(void *socket) ['zmq_close' => "${target}::zmq_close"] => ['pointer'] => 'int' ); $ffi->attach( # const char *zmq_strerror(int errnum) ['zmq_strerror' => "${target}::zmq_strerror"] => ['int'] => 'string' ); $ffi->attach( # int zmq_errno(void) ['zmq_errno' => "${target}::zmq_errno"] => [] => 'int' ); $ffi->attach( # int zmq_curve_keypair (char *z85_public_key, char *z85_secret_key); ['zmq_curve_keypair' => "${target}::zmq_curve_keypair"] => ['opaque', 'opaque'] => 'int' ); $ffi->attach( # char *zmq_z85_encode (char *dest, const uint8_t *data, size_t size); ['zmq_z85_encode' => "${target}::zmq_z85_encode"] => ['opaque', 'string', 'size_t'] => 'pointer' ); $ffi->attach( # uint8_t *zmq_z85_decode (uint8_t *dest, const char *string); ['zmq_z85_decode' => "${target}::zmq_z85_decode"] => ['opaque', 'string'] => 'pointer' ); $ffi->attach( # int zmq_socket_monitor (void *socket, char *endpoint, int events); ['zmq_socket_monitor' => "${target}::zmq_socket_monitor"] => ['pointer', 'string', 'int'] => 'int' ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ4::Raw =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/Versioner.pm0000644000000000000000000000134614463157020015354 0ustar rootrootpackage ZMQ::FFI::Versioner; $ZMQ::FFI::Versioner::VERSION = '1.19'; use Moo::Role; use ZMQ::FFI::Util qw(zmq_version); requires q(soname); has _version_parts => ( is => 'ro', lazy => 1, default => sub { [zmq_version($_[0]->soname)] } ); sub version { return @{$_[0]->_version_parts}; } sub verstr { return join('.', $_[0]->version); } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::Versioner =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ErrorHelper.pm0000644000000000000000000000374214463157020015633 0ustar rootrootpackage ZMQ::FFI::ErrorHelper; $ZMQ::FFI::ErrorHelper::VERSION = '1.19'; use Carp; use FFI::Platypus; use ZMQ::FFI::Util qw(zmq_version); use Moo::Role; has die_on_error => ( is => 'rw', default => 1, ); has last_errno => ( is => 'rw', lazy => 1, default => 0, ); sub last_strerror { my ($self) = @_; my $strerr; { no strict q/refs/; my $class = ref $self; $strerr = &{"$class\::zmq_strerror"}($self->last_errno); } return $strerr; } sub has_error { return $_[0]->last_errno; } sub check_error { my ($self, $func, $rc) = @_; $self->{last_errno} = 0; my $errno; { no strict q/refs/; my $class = ref $self; $errno = &{"$class\::zmq_errno"}(); } if ( $rc == -1 ) { $self->{last_errno} = $errno; if ($self->die_on_error) { $self->fatal($func) } } } sub check_null { my ($self, $func, $obj) = @_; $self->{last_errno} = 0; my $errno; { no strict q/refs/; my $class = ref $self; $errno = &{"$class\::zmq_errno"}(); } unless ($obj) { $self->{last_errno} = $errno; if ($self->die_on_error) { $self->fatal($func) } } } sub fatal { my ($self, $func) = @_; my $strerr = $self->last_strerror; confess "$func: $strerr"; } sub bad_version { my ($self, $verstr, $msg, $use_die) = @_; if ($use_die) { die "$msg\n" . "your version: $verstr"; } else { croak "$msg\n" . "your version: $verstr"; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ErrorHelper =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/Custom/0000755000000000000000000000000014463157020014310 5ustar rootrootZMQ-FFI-1.19/lib/ZMQ/FFI/Custom/Raw.pm0000644000000000000000000000377414463157020015412 0ustar rootrootpackage ZMQ::FFI::Custom::Raw; $ZMQ::FFI::Custom::Raw::VERSION = '1.19'; sub load { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname // 'libzmq.so' ); my $target = caller; # # 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' => "${target}::zmq_getsockopt_binary"] => ['pointer', 'int', 'pointer', 'size_t*'] => 'int' ); $ffi->attach( ['zmq_getsockopt' => "${target}::zmq_getsockopt_int"] => ['pointer', 'int', 'int*', 'size_t*'] => 'int' ); $ffi->attach( ['zmq_getsockopt' => "${target}::zmq_getsockopt_int64"] => ['pointer', 'int', 'sint64*', 'size_t*'] => 'int' ); $ffi->attach( ['zmq_getsockopt' => "${target}::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' => "${target}::zmq_setsockopt_binary"] => ['pointer', 'int', 'pointer', 'size_t'] => 'int' ); $ffi->attach( ['zmq_setsockopt' => "${target}::zmq_setsockopt_int"] => ['pointer', 'int', 'int*', 'size_t'] => 'int' ); $ffi->attach( ['zmq_setsockopt' => "${target}::zmq_setsockopt_int64"] => ['pointer', 'int', 'sint64*', 'size_t'] => 'int' ); $ffi->attach( ['zmq_setsockopt' => "${target}::zmq_setsockopt_uint64"] => ['pointer', 'int', 'uint64*', 'size_t'] => 'int' ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::Custom::Raw =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ3/0000755000000000000000000000000014463157020013570 5ustar rootrootZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ3/Socket.pm0000644000000000000000000003132314463157020015360 0ustar rootroot# # Module Generated by Template::Tiny on Fri Aug 4 11:16:27 UTC 2023 # package ZMQ::FFI::ZMQ3::Socket; $ZMQ::FFI::ZMQ3::Socket::VERSION = '1.19'; use FFI::Platypus; use FFI::Platypus::Buffer; use FFI::Platypus::Memory qw(malloc free memcpy); use Carp qw(croak carp); use Try::Tiny; use ZMQ::FFI::ZMQ3::Raw; use ZMQ::FFI::Custom::Raw; use ZMQ::FFI::Constants qw(:all); use ZMQ::FFI::Util qw(current_tid); 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) { ZMQ::FFI::Custom::Raw::load($self->soname); ZMQ::FFI::ZMQ3::Raw::load($self->soname); $FFI_LOADED = 1; } # 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); } sub connect { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->connect($endpoint)'; } $self->check_error( 'zmq_connect', zmq_connect($self->socket_ptr, $endpoint) ); } sub disconnect { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->disconnect($endpoint)'; } $self->check_error( 'zmq_disconnect', zmq_disconnect($self->socket_ptr, $endpoint) ); } sub bind { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->bind($endpoint)' } $self->check_error( 'zmq_bind', zmq_bind($self->socket_ptr, $endpoint) ); } sub unbind { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->unbind($endpoint)'; } $self->check_error( 'zmq_unbind', zmq_unbind($self->socket_ptr, $endpoint) ); } sub send { # 0: self # 1: data # 2: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $_[0]->{last_errno} = 0; use bytes; my $length = length($_[1]); no bytes; if ( -1 == zmq_send($_[0]->socket_ptr, $_[1], $length, ($_[2] // 0)) ) { $_[0]->{last_errno} = zmq_errno(); if ($_[0]->die_on_error) { $_[0]->fatal('zmq_send'); } return; } } sub send_multipart { # 0: self # 1: partsref # 2: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } 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 { # 0: self # 1: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $_[0]->{last_errno} = 0; # retval = msg size my $retval = zmq_msg_recv($_[0]->{"_zmq_msg_t"}, $_[0]->socket_ptr, $_[1] // 0); if ( $retval == -1 ) { $_[0]->{last_errno} = zmq_errno(); if ($_[0]->die_on_error) { $_[0]->fatal('zmq_msg_recv'); } return; } if ($retval) { return buffer_to_scalar(zmq_msg_data($_[0]->{"_zmq_msg_t"}), $retval); } return ''; } sub recv_multipart { # 0: self # 1: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } 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 { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_FD, 'int'); } sub get_linger { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_LINGER, 'int'); } sub set_linger { my ($self, $linger) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_LINGER, 'int', $linger); } sub get_identity { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_IDENTITY, 'binary'); } sub set_identity { my ($self, $id) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_IDENTITY, 'binary', $id); } sub subscribe { my ($self, $topic) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_SUBSCRIBE, 'binary', $topic); } sub unsubscribe { my ($self, $topic) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_UNSUBSCRIBE, 'binary', $topic); } sub has_pollin { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLIN; } sub has_pollout { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLOUT; } sub get { my ($self, $opt, $opt_type) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } my $optval; my $optval_len; for ($opt_type) { if ($_ =~ /^(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_ptr, $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); } } elsif ($_ eq 'int') { $optval_len = $self->sockopt_sizes->{'int'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } elsif ($_ eq 'int64_t') { $optval_len = $self->sockopt_sizes->{'sint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } elsif ($_ eq 'uint64_t') { $optval_len = $self->sockopt_sizes->{'uint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_uint64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } else { croak "unknown type $opt_type"; } } if ($optval ne '') { return $optval; } return; } sub set { my ($self, $opt, $opt_type, $optval) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } for ($opt_type) { if ($_ =~ /^(binary|string)$/) { my ($optval_ptr, $optval_len) = scalar_to_buffer($optval); $self->check_error( 'zmq_setsockopt', zmq_setsockopt_binary( $self->socket_ptr, $opt, $optval_ptr, $optval_len ) ); } elsif ($_ eq 'int') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'int'} ) ); } elsif ($_ eq 'int64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'sint64'} ) ); } elsif ($_ eq 'uint64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_uint64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'uint64'} ) ); } else { croak "unknown type $opt_type"; } } return; } sub close { my ($self) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } # don't try to cleanup socket cloned from another thread return unless $self->_tid == current_tid(); # don't try to cleanup socket copied from another process (fork) return unless $self->_pid == $$; $self->check_error( 'zmq_msg_close', zmq_msg_close($self->_zmq_msg_t) ); $self->check_error( 'zmq_close', zmq_close($self->socket_ptr) ); $self->socket_ptr(-1); } sub monitor { my ($self, $endpoint, $event) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->monitor($endpoint, $events)'; } $self->check_error( 'zmq_socket_monitor', zmq_socket_monitor($self->socket_ptr, $endpoint, $event) ); } sub recv_event { my ($self, $flags) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } my $msg = $self->recv($flags); my $len = length($msg); my ($id, $data, $value); if ($len == $self->event_size) { ($id, $data, $value) = unpack('i p i', $msg); } elsif ($len > $self->event_size) { my $padding = ($len - $self->event_size) / 2; ($id, $data, $value) = unpack("i x$padding p i x$padding", $msg); } return ($id, $value, $data); } sub DEMOLISH { my ($self) = @_; # remove ourselves from the context object so that we dont leak $self->context->_remove_socket($self) if (defined $self->context); return if $self->socket_ptr == -1; $self->close(); } 1; # vim:ft=perl __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ3::Socket =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ3/Context.pm0000644000000000000000000001072314463157020015555 0ustar rootroot# # Module Generated by Template::Tiny on Fri Aug 4 11:16:27 UTC 2023 # package ZMQ::FFI::ZMQ3::Context; $ZMQ::FFI::ZMQ3::Context::VERSION = '1.19'; use FFI::Platypus; use ZMQ::FFI::Util qw(zmq_soname current_tid); use ZMQ::FFI::Constants qw(:all); use ZMQ::FFI::ZMQ3::Socket; use ZMQ::FFI::ZMQ3::Raw; use ZMQ::FFI::Custom::Raw; use Try::Tiny; use Scalar::Util qw(weaken); use Moo; use namespace::clean; with qw( ZMQ::FFI::ContextRole ZMQ::FFI::ErrorHelper ZMQ::FFI::Versioner ); my $FFI_LOADED; sub BUILD { my ($self) = @_; unless ($FFI_LOADED) { ZMQ::FFI::Custom::Raw::load($self->soname); ZMQ::FFI::ZMQ3::Raw::load($self->soname); $FFI_LOADED = 1; } $self->init() } sub init { my ($self) = @_; try { $self->context_ptr( zmq_ctx_new() ); $self->check_null('zmq_ctx_new', $self->context_ptr); } catch { $self->context_ptr(-1); die $_; }; if ( $self->has_threads ) { $self->set(ZMQ_IO_THREADS, $self->threads); } if ( $self->has_max_sockets ) { $self->set(ZMQ_MAX_SOCKETS, $self->max_sockets); } } sub get { my ($self, $option) = @_; my $option_val = zmq_ctx_get($self->context_ptr, $option); $self->check_error('zmq_ctx_get', $option_val); return $option_val; } sub set { my ($self, $option, $option_val) = @_; $self->check_error( 'zmq_ctx_set', zmq_ctx_set($self->context_ptr, $option, $option_val) ); } sub socket { my ($self, $type) = @_; my $socket; try { my $socket_ptr = zmq_socket($self->context_ptr, $type); $self->check_null('zmq_socket', $socket_ptr); $socket = ZMQ::FFI::ZMQ3::Socket->new( socket_ptr => $socket_ptr, context => $self, # this will become a weak ref type => $type, soname => $self->soname, ); } catch { die $_; }; # add the socket to the socket hash $self->_add_socket($socket); return $socket; } sub proxy { my ($self, $frontend, $backend, $capture) = @_; $self->check_error( 'zmq_proxy', zmq_proxy( $frontend->socket_ptr, $backend->socket_ptr, defined $capture ? $capture->socket_ptr : undef, ) ); } sub device { my ($self, $type, $frontend, $backend) = @_; $self->bad_version( $self->verstr, "zmq_device not available in zmq >= 3.x", ); } sub destroy { my ($self) = @_; return if $self->context_ptr == -1; # don't try to cleanup context cloned from another thread return unless $self->_tid == current_tid(); # don't try to cleanup context copied from another process (fork) return unless $self->_pid == $$; $self->check_error( 'zmq_ctx_destroy', zmq_ctx_destroy($self->context_ptr) ); $self->context_ptr(-1); } sub curve_keypair { my ($self) = @_; $self->bad_version( $self->verstr, "curve_keypair not available in < zmq 4.x" ); } sub z85_encode { my ($self) = @_; $self->bad_version( $self->verstr, "z85_encode not available in < zmq 4.x" ); } sub z85_decode { my ($self) = @_; $self->bad_version( $self->verstr, "z85_decode not available in < zmq 4.x" ); } sub has_capability { my ($self) = @_; $self->bad_version( $self->verstr, "has_capability not available in < zmq 4.1" ); } sub _add_socket { my ($self, $socket) = @_; weaken($self->sockets->{$socket} = $socket); } sub _remove_socket { my ($self, $socket) = @_; delete($self->sockets->{$socket}); } sub DEMOLISH { my ($self) = @_; return if $self->context_ptr == -1; # check defined to guard against # undef objects during global destruction if (defined $self->sockets) { for my $socket_k (keys %{$self->sockets}) { my $socket = $self->_remove_socket($socket_k); $socket->close() if defined $socket && $socket->socket_ptr != -1; } } $self->destroy(); } 1; # vim:ft=perl __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ3::Context =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ3/Raw.pm0000644000000000000000000001025714463157020014664 0ustar rootrootpackage ZMQ::FFI::ZMQ3::Raw; $ZMQ::FFI::ZMQ3::Raw::VERSION = '1.19'; use FFI::Platypus; sub load { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname // 'libzmq.so' ); my $target = caller; $ffi->attach( # void *zmq_ctx_new() ['zmq_ctx_new' => "${target}::zmq_ctx_new"] => [] => 'pointer' ); $ffi->attach( # int zmq_ctx_get(void *context, int option_name) ['zmq_ctx_get' => "${target}::zmq_ctx_get"] => ['pointer', 'int'] => 'int' ); $ffi->attach( # int zmq_ctx_set(void *context, int option_name, int option_value) ['zmq_ctx_set' => "${target}::zmq_ctx_set"] => ['pointer', 'int', 'int'] => 'int' ); $ffi->attach( # void *zmq_socket(void *context, int type) ['zmq_socket' => "${target}::zmq_socket"] => ['pointer', 'int'] => 'pointer' ); $ffi->attach( # int zmq_proxy(const void *front, const void *back, const void *cap) ['zmq_proxy' => "${target}::zmq_proxy"] => ['pointer', 'pointer', 'pointer'] => 'int' ); $ffi->attach( # int zmq_ctx_destroy (void *context) ['zmq_ctx_destroy' => "${target}::zmq_ctx_destroy"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_send(void *socket, void *buf, size_t len, int flags) ['zmq_send' => "${target}::zmq_send"] => ['pointer', 'string', 'size_t', 'int'] => 'int' ); $ffi->attach( # int zmq_msg_recv(zmq_msg_t *msg, void *socket, int flags) ['zmq_msg_recv' => "${target}::zmq_msg_recv"] => ['pointer', 'pointer', 'int'] => 'int' ); $ffi->attach( # int zmq_unbind(void *socket, const char *endpoint) ['zmq_unbind' => "${target}::zmq_unbind"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_disconnect(void *socket, const char *endpoint) ['zmq_disconnect' => "${target}::zmq_disconnect"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_connect(void *socket, const char *endpoint) ['zmq_connect' => "${target}::zmq_connect"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_bind(void *socket, const char *endpoint) ['zmq_bind' => "${target}::zmq_bind"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_msg_init(zmq_msg_t *msg) ['zmq_msg_init' => "${target}::zmq_msg_init"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_msg_init_size(zmq_msg_t *msg, size_t size) ['zmq_msg_init_size' => "${target}::zmq_msg_init_size"] => ['pointer', 'int'] => 'int' ); $ffi->attach( # size_t zmq_msg_size(zmq_msg_t *msg) ['zmq_msg_size' => "${target}::zmq_msg_size"] => ['pointer'] => 'int' ); $ffi->attach( # void *zmq_msg_data(zmq_msg_t *msg) ['zmq_msg_data' => "${target}::zmq_msg_data"] => ['pointer'] => 'pointer' ); $ffi->attach( # int zmq_msg_close(zmq_msg_t *msg) ['zmq_msg_close' => "${target}::zmq_msg_close"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_close(void *socket) ['zmq_close' => "${target}::zmq_close"] => ['pointer'] => 'int' ); $ffi->attach( # const char *zmq_strerror(int errnum) ['zmq_strerror' => "${target}::zmq_strerror"] => ['int'] => 'string' ); $ffi->attach( # int zmq_errno(void) ['zmq_errno' => "${target}::zmq_errno"] => [] => 'int' ); $ffi->attach( # int zmq_socket_monitor (void *socket, char *addr, int events); ['zmq_socket_monitor' => "${target}::zmq_socket_monitor"] => ['pointer', 'string', 'int'] => 'int' ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ3::Raw =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/SocketRole.pm0000644000000000000000000000521014463157020015444 0ustar rootrootpackage ZMQ::FFI::SocketRole; $ZMQ::FFI::SocketRole::VERSION = '1.19'; use FFI::Platypus; use FFI::Platypus::Memory qw(malloc); use ZMQ::FFI::Constants qw(zmq_msg_t_size); use ZMQ::FFI::Util qw(current_tid zmq_version); use Moo::Role; has soname => ( is => 'ro', required => 1, ); # zmq constant socket type, e.g. ZMQ_REQ has type => ( is => 'ro', required => 1, ); # real underlying zmq socket pointer has socket_ptr => ( is => 'rw', default => -1, ); # a weak reference to the context object has context => ( is => 'ro', required => 1, weak_ref => 1, ); # message struct to reuse when sending/receiving has _zmq_msg_t => ( is => 'ro', lazy => 1, builder => '_build_zmq_msg_t', ); # used to make sure we handle fork situations correctly has _pid => ( is => 'ro', default => sub { $$ }, ); # used to make sure we handle thread situations correctly has _tid => ( is => 'ro', default => sub { current_tid() }, ); has sockopt_sizes => ( is => 'ro', lazy => 1, builder => '_build_sockopt_sizes' ); has event_size => ( is => 'ro', lazy => 1, builder => '_build_event_size' ); sub _build_zmq_msg_t { my ($self) = @_; my $msg_ptr; { no strict q/refs/; my $class = ref $self; $msg_ptr = malloc(zmq_msg_t_size); &{"$class\::zmq_msg_init"}($msg_ptr); } return $msg_ptr; } sub _build_sockopt_sizes { my $ffi = FFI::Platypus->new(); return { int => $ffi->sizeof('int'), sint64 => $ffi->sizeof('sint64'), uint64 => $ffi->sizeof('uint64'), }; } sub _build_event_size { my $ffi = FFI::Platypus->new(); my ($major, $minor, $patch) = zmq_version(); my $size; if ($major == 3) { $size = $ffi->sizeof('int') * 2 + $ffi->sizeof('opaque'); } elsif ($major > 3) { $size = $ffi->sizeof('uint16', 'sint32'); } return $size; } requires qw( connect disconnect bind unbind send send_multipart recv recv_multipart get_fd get_linger set_linger get_identity set_identity subscribe unsubscribe has_pollin has_pollout get set close monitor recv_event ); 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::SocketRole =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/Constants.pm0000644000000000000000000003047614463157020015362 0ustar rootrootpackage ZMQ::FFI::Constants; $ZMQ::FFI::Constants::VERSION = '1.19'; # ABSTRACT: Generated module of zmq constants. All constants, all versions. # Generated using ZMQ versions v2.1.0-v4.3.4 use strict; use warnings; use Exporter 'import'; our @EXPORT_OK = qw( ZMQ_AFFINITY ZMQ_BACKLOG ZMQ_BINDTODEVICE ZMQ_BLOCKY ZMQ_CHANNEL ZMQ_CLIENT ZMQ_CONFLATE ZMQ_CONNECT_RID ZMQ_CONNECT_ROUTING_ID ZMQ_CONNECT_TIMEOUT ZMQ_CURRENT_EVENT_VERSION ZMQ_CURRENT_EVENT_VERSION_DRAFT ZMQ_CURVE ZMQ_CURVE_PUBLICKEY ZMQ_CURVE_SECRETKEY ZMQ_CURVE_SERVER ZMQ_CURVE_SERVERKEY ZMQ_DEALER ZMQ_DEFINED_STDINT ZMQ_DELAY_ATTACH_ON_CONNECT ZMQ_DELIMITER ZMQ_DGRAM ZMQ_DISCONNECT_MSG ZMQ_DISH ZMQ_DONTWAIT ZMQ_EVENTS ZMQ_EVENT_ACCEPTED ZMQ_EVENT_ACCEPT_FAILED ZMQ_EVENT_ALL ZMQ_EVENT_BIND_FAILED ZMQ_EVENT_CLOSED ZMQ_EVENT_CLOSE_FAILED ZMQ_EVENT_CONNECTED ZMQ_EVENT_CONNECT_DELAYED ZMQ_EVENT_CONNECT_RETRIED ZMQ_EVENT_DISCONNECTED ZMQ_EVENT_HANDSHAKE_FAILED ZMQ_EVENT_HANDSHAKE_FAILED_AUTH ZMQ_EVENT_HANDSHAKE_FAILED_NO_DETAIL ZMQ_EVENT_HANDSHAKE_FAILED_PROTOCOL ZMQ_EVENT_HANDSHAKE_SUCCEED ZMQ_EVENT_HANDSHAKE_SUCCEEDED ZMQ_EVENT_LISTENING ZMQ_EVENT_MONITOR_STOPPED ZMQ_EVENT_PIPES_STATS ZMQ_FAIL_UNROUTABLE ZMQ_FD ZMQ_FORWARDER ZMQ_GATHER ZMQ_GSSAPI ZMQ_GSSAPI_NT_HOSTBASED ZMQ_GSSAPI_NT_KRB5_PRINCIPAL ZMQ_GSSAPI_NT_USER_NAME ZMQ_GSSAPI_PLAINTEXT ZMQ_GSSAPI_PRINCIPAL ZMQ_GSSAPI_PRINCIPAL_NAMETYPE ZMQ_GSSAPI_SERVER ZMQ_GSSAPI_SERVICE_PRINCIPAL ZMQ_GSSAPI_SERVICE_PRINCIPAL_NAMETYPE ZMQ_HANDSHAKE_IVL ZMQ_HAS_CAPABILITIES ZMQ_HAUSNUMERO ZMQ_HEARTBEAT_IVL ZMQ_HEARTBEAT_TIMEOUT ZMQ_HEARTBEAT_TTL ZMQ_HELLO_MSG ZMQ_HWM ZMQ_IDENTITY ZMQ_IDENTITY_FD ZMQ_IMMEDIATE ZMQ_INVERT_MATCHING ZMQ_IN_BATCH_SIZE ZMQ_IO_THREADS ZMQ_IO_THREADS_DFLT ZMQ_IPC_FILTER_GID ZMQ_IPC_FILTER_PID ZMQ_IPC_FILTER_UID ZMQ_IPV4ONLY ZMQ_IPV6 ZMQ_LAST_ENDPOINT ZMQ_LINGER ZMQ_LOOPBACK_FASTPATH ZMQ_MAXMSGSIZE ZMQ_MAX_MSGSZ ZMQ_MAX_SOCKETS ZMQ_MAX_SOCKETS_DFLT ZMQ_MAX_VSM_SIZE ZMQ_MCAST_LOOP ZMQ_MECHANISM ZMQ_METADATA ZMQ_MORE ZMQ_MSG_MASK ZMQ_MSG_MORE ZMQ_MSG_SHARED ZMQ_MSG_T_SIZE ZMQ_MULTICAST_HOPS ZMQ_MULTICAST_LOOP ZMQ_MULTICAST_MAXTPDU ZMQ_NOBLOCK ZMQ_NOTIFY_CONNECT ZMQ_NOTIFY_DISCONNECT ZMQ_NULL ZMQ_ONLY_FIRST_SUBSCRIBE ZMQ_OUT_BATCH_SIZE ZMQ_PAIR ZMQ_PEER ZMQ_PLAIN ZMQ_PLAIN_PASSWORD ZMQ_PLAIN_SERVER ZMQ_PLAIN_USERNAME ZMQ_POLLERR ZMQ_POLLIN ZMQ_POLLITEMS_DFLT ZMQ_POLLOUT ZMQ_POLLPRI ZMQ_PRIORITY ZMQ_PROBE_ROUTER ZMQ_PROTOCOL_ERROR_WS_UNSPECIFIED ZMQ_PROTOCOL_ERROR_ZAP_BAD_REQUEST_ID ZMQ_PROTOCOL_ERROR_ZAP_BAD_VERSION ZMQ_PROTOCOL_ERROR_ZAP_INVALID_METADATA ZMQ_PROTOCOL_ERROR_ZAP_INVALID_STATUS_CODE ZMQ_PROTOCOL_ERROR_ZAP_MALFORMED_REPLY ZMQ_PROTOCOL_ERROR_ZAP_UNSPECIFIED ZMQ_PROTOCOL_ERROR_ZMTP_CRYPTOGRAPHIC ZMQ_PROTOCOL_ERROR_ZMTP_INVALID_METADATA ZMQ_PROTOCOL_ERROR_ZMTP_INVALID_SEQUENCE ZMQ_PROTOCOL_ERROR_ZMTP_KEY_EXCHANGE ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_ERROR ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_HELLO ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_INITIATE ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_MESSAGE ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_READY ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_UNSPECIFIED ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_WELCOME ZMQ_PROTOCOL_ERROR_ZMTP_MECHANISM_MISMATCH ZMQ_PROTOCOL_ERROR_ZMTP_UNEXPECTED_COMMAND ZMQ_PROTOCOL_ERROR_ZMTP_UNSPECIFIED ZMQ_PUB ZMQ_PULL ZMQ_PUSH ZMQ_QUEUE ZMQ_RADIO ZMQ_RATE ZMQ_RCVBUF ZMQ_RCVHWM ZMQ_RCVMORE ZMQ_RCVTIMEO ZMQ_RECONNECT_IVL ZMQ_RECONNECT_IVL_MAX ZMQ_RECONNECT_STOP ZMQ_RECONNECT_STOP_AFTER_DISCONNECT ZMQ_RECONNECT_STOP_CONN_REFUSED ZMQ_RECONNECT_STOP_HANDSHAKE_FAILED ZMQ_RECOVERY_IVL ZMQ_RECOVERY_IVL_MSEC ZMQ_REP ZMQ_REQ ZMQ_REQ_CORRELATE ZMQ_REQ_RELAXED ZMQ_ROUTER ZMQ_ROUTER_HANDOVER ZMQ_ROUTER_MANDATORY ZMQ_ROUTER_NOTIFY ZMQ_ROUTER_RAW ZMQ_ROUTING_ID ZMQ_SCATTER ZMQ_SERVER ZMQ_SHARED ZMQ_SNDBUF ZMQ_SNDHWM ZMQ_SNDMORE ZMQ_SNDTIMEO ZMQ_SOCKET_LIMIT ZMQ_SOCKS_PASSWORD ZMQ_SOCKS_PROXY ZMQ_SOCKS_USERNAME ZMQ_SRCFD ZMQ_STREAM ZMQ_STREAMER ZMQ_STREAM_NOTIFY ZMQ_SUB ZMQ_SUBSCRIBE ZMQ_SWAP ZMQ_TCP_ACCEPT_FILTER ZMQ_TCP_KEEPALIVE ZMQ_TCP_KEEPALIVE_CNT ZMQ_TCP_KEEPALIVE_IDLE ZMQ_TCP_KEEPALIVE_INTVL ZMQ_TCP_MAXRT ZMQ_THREAD_AFFINITY_CPU_ADD ZMQ_THREAD_AFFINITY_CPU_REMOVE ZMQ_THREAD_NAME_PREFIX ZMQ_THREAD_PRIORITY ZMQ_THREAD_SAFE ZMQ_THREAD_SCHED_POLICY ZMQ_TOS ZMQ_TYPE ZMQ_UNSUBSCRIBE ZMQ_USE_FD ZMQ_VMCI_BUFFER_MAX_SIZE ZMQ_VMCI_BUFFER_MIN_SIZE ZMQ_VMCI_BUFFER_SIZE ZMQ_VMCI_CONNECT_TIMEOUT ZMQ_VSM ZMQ_WSS_CERT_PEM ZMQ_WSS_HOSTNAME ZMQ_WSS_KEY_PEM ZMQ_WSS_TRUST_PEM ZMQ_WSS_TRUST_SYSTEM ZMQ_XPUB ZMQ_XPUB_MANUAL ZMQ_XPUB_MANUAL_LAST_VALUE ZMQ_XPUB_NODROP ZMQ_XPUB_VERBOSE ZMQ_XPUB_VERBOSER ZMQ_XPUB_WELCOME_MSG ZMQ_XREP ZMQ_XREQ ZMQ_XSUB ZMQ_ZAP_DOMAIN ZMQ_ZAP_ENFORCE_DOMAIN ZMQ_ZERO_COPY_RECV zmq_msg_t_size ); our %EXPORT_TAGS = (all => [@EXPORT_OK]); sub ZMQ_AFFINITY { 4 } sub ZMQ_BACKLOG { 19 } sub ZMQ_BINDTODEVICE { 92 } sub ZMQ_BLOCKY { 70 } sub ZMQ_CHANNEL { 20 } sub ZMQ_CLIENT { 13 } sub ZMQ_CONFLATE { 54 } sub ZMQ_CONNECT_RID { 61 } sub ZMQ_CONNECT_ROUTING_ID { 61 } sub ZMQ_CONNECT_TIMEOUT { 79 } sub ZMQ_CURRENT_EVENT_VERSION { 1 } sub ZMQ_CURRENT_EVENT_VERSION_DRAFT { 2 } sub ZMQ_CURVE { 2 } sub ZMQ_CURVE_PUBLICKEY { 48 } sub ZMQ_CURVE_SECRETKEY { 49 } sub ZMQ_CURVE_SERVER { 47 } sub ZMQ_CURVE_SERVERKEY { 50 } sub ZMQ_DEALER { 5 } sub ZMQ_DEFINED_STDINT { 1 } sub ZMQ_DELAY_ATTACH_ON_CONNECT { 39 } sub ZMQ_DELIMITER { 31 } sub ZMQ_DGRAM { 18 } sub ZMQ_DISCONNECT_MSG { 111 } sub ZMQ_DISH { 15 } sub ZMQ_DONTWAIT { 1 } sub ZMQ_EVENTS { 15 } sub ZMQ_EVENT_ACCEPTED { 32 } sub ZMQ_EVENT_ACCEPT_FAILED { 64 } sub ZMQ_EVENT_ALL { 65535 } sub ZMQ_EVENT_BIND_FAILED { 16 } sub ZMQ_EVENT_CLOSED { 128 } sub ZMQ_EVENT_CLOSE_FAILED { 256 } sub ZMQ_EVENT_CONNECTED { 1 } sub ZMQ_EVENT_CONNECT_DELAYED { 2 } sub ZMQ_EVENT_CONNECT_RETRIED { 4 } sub ZMQ_EVENT_DISCONNECTED { 512 } sub ZMQ_EVENT_HANDSHAKE_FAILED { 2048 } sub ZMQ_EVENT_HANDSHAKE_FAILED_AUTH { 16384 } sub ZMQ_EVENT_HANDSHAKE_FAILED_NO_DETAIL { 2048 } sub ZMQ_EVENT_HANDSHAKE_FAILED_PROTOCOL { 8192 } sub ZMQ_EVENT_HANDSHAKE_SUCCEED { 4096 } sub ZMQ_EVENT_HANDSHAKE_SUCCEEDED { 4096 } sub ZMQ_EVENT_LISTENING { 8 } sub ZMQ_EVENT_MONITOR_STOPPED { 1024 } sub ZMQ_EVENT_PIPES_STATS { 65536 } sub ZMQ_FAIL_UNROUTABLE { 33 } sub ZMQ_FD { 14 } sub ZMQ_FORWARDER { 2 } sub ZMQ_GATHER { 16 } sub ZMQ_GSSAPI { 3 } sub ZMQ_GSSAPI_NT_HOSTBASED { 0 } sub ZMQ_GSSAPI_NT_KRB5_PRINCIPAL { 2 } sub ZMQ_GSSAPI_NT_USER_NAME { 1 } sub ZMQ_GSSAPI_PLAINTEXT { 65 } sub ZMQ_GSSAPI_PRINCIPAL { 63 } sub ZMQ_GSSAPI_PRINCIPAL_NAMETYPE { 90 } sub ZMQ_GSSAPI_SERVER { 62 } sub ZMQ_GSSAPI_SERVICE_PRINCIPAL { 64 } sub ZMQ_GSSAPI_SERVICE_PRINCIPAL_NAMETYPE { 91 } sub ZMQ_HANDSHAKE_IVL { 66 } sub ZMQ_HAS_CAPABILITIES { 1 } sub ZMQ_HAUSNUMERO { 156384712 } sub ZMQ_HEARTBEAT_IVL { 75 } sub ZMQ_HEARTBEAT_TIMEOUT { 77 } sub ZMQ_HEARTBEAT_TTL { 76 } sub ZMQ_HELLO_MSG { 110 } sub ZMQ_HWM { 1 } sub ZMQ_IDENTITY { 5 } sub ZMQ_IDENTITY_FD { 67 } sub ZMQ_IMMEDIATE { 39 } sub ZMQ_INVERT_MATCHING { 74 } sub ZMQ_IN_BATCH_SIZE { 101 } sub ZMQ_IO_THREADS { 1 } sub ZMQ_IO_THREADS_DFLT { 1 } sub ZMQ_IPC_FILTER_GID { 60 } sub ZMQ_IPC_FILTER_PID { 58 } sub ZMQ_IPC_FILTER_UID { 59 } sub ZMQ_IPV4ONLY { 31 } sub ZMQ_IPV6 { 42 } sub ZMQ_LAST_ENDPOINT { 32 } sub ZMQ_LINGER { 17 } sub ZMQ_LOOPBACK_FASTPATH { 94 } sub ZMQ_MAXMSGSIZE { 22 } sub ZMQ_MAX_MSGSZ { 5 } sub ZMQ_MAX_SOCKETS { 2 } sub ZMQ_MAX_SOCKETS_DFLT { 1023 } sub ZMQ_MAX_VSM_SIZE { 30 } sub ZMQ_MCAST_LOOP { 10 } sub ZMQ_MECHANISM { 43 } sub ZMQ_METADATA { 95 } sub ZMQ_MORE { 1 } sub ZMQ_MSG_MASK { 129 } sub ZMQ_MSG_MORE { 1 } sub ZMQ_MSG_SHARED { 128 } sub ZMQ_MSG_T_SIZE { 6 } sub ZMQ_MULTICAST_HOPS { 25 } sub ZMQ_MULTICAST_LOOP { 96 } sub ZMQ_MULTICAST_MAXTPDU { 84 } sub ZMQ_NOBLOCK { 1 } sub ZMQ_NOTIFY_CONNECT { 1 } sub ZMQ_NOTIFY_DISCONNECT { 2 } sub ZMQ_NULL { 0 } sub ZMQ_ONLY_FIRST_SUBSCRIBE { 108 } sub ZMQ_OUT_BATCH_SIZE { 102 } sub ZMQ_PAIR { 0 } sub ZMQ_PEER { 19 } sub ZMQ_PLAIN { 1 } sub ZMQ_PLAIN_PASSWORD { 46 } sub ZMQ_PLAIN_SERVER { 44 } sub ZMQ_PLAIN_USERNAME { 45 } sub ZMQ_POLLERR { 4 } sub ZMQ_POLLIN { 1 } sub ZMQ_POLLITEMS_DFLT { 16 } sub ZMQ_POLLOUT { 2 } sub ZMQ_POLLPRI { 8 } sub ZMQ_PRIORITY { 112 } sub ZMQ_PROBE_ROUTER { 51 } sub ZMQ_PROTOCOL_ERROR_WS_UNSPECIFIED { 805306368 } sub ZMQ_PROTOCOL_ERROR_ZAP_BAD_REQUEST_ID { 536870914 } sub ZMQ_PROTOCOL_ERROR_ZAP_BAD_VERSION { 536870915 } sub ZMQ_PROTOCOL_ERROR_ZAP_INVALID_METADATA { 536870917 } sub ZMQ_PROTOCOL_ERROR_ZAP_INVALID_STATUS_CODE { 536870916 } sub ZMQ_PROTOCOL_ERROR_ZAP_MALFORMED_REPLY { 536870913 } sub ZMQ_PROTOCOL_ERROR_ZAP_UNSPECIFIED { 536870912 } sub ZMQ_PROTOCOL_ERROR_ZMTP_CRYPTOGRAPHIC { 285212673 } sub ZMQ_PROTOCOL_ERROR_ZMTP_INVALID_METADATA { 268435480 } sub ZMQ_PROTOCOL_ERROR_ZMTP_INVALID_SEQUENCE { 268435458 } sub ZMQ_PROTOCOL_ERROR_ZMTP_KEY_EXCHANGE { 268435459 } sub ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_ERROR { 268435477 } sub ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_HELLO { 268435475 } sub ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_INITIATE { 268435476 } sub ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_MESSAGE { 268435474 } sub ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_READY { 268435478 } sub ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_UNSPECIFIED { 268435473 } sub ZMQ_PROTOCOL_ERROR_ZMTP_MALFORMED_COMMAND_WELCOME { 268435479 } sub ZMQ_PROTOCOL_ERROR_ZMTP_MECHANISM_MISMATCH { 285212674 } sub ZMQ_PROTOCOL_ERROR_ZMTP_UNEXPECTED_COMMAND { 268435457 } sub ZMQ_PROTOCOL_ERROR_ZMTP_UNSPECIFIED { 268435456 } sub ZMQ_PUB { 1 } sub ZMQ_PULL { 7 } sub ZMQ_PUSH { 8 } sub ZMQ_QUEUE { 3 } sub ZMQ_RADIO { 14 } sub ZMQ_RATE { 8 } sub ZMQ_RCVBUF { 12 } sub ZMQ_RCVHWM { 24 } sub ZMQ_RCVMORE { 13 } sub ZMQ_RCVTIMEO { 27 } sub ZMQ_RECONNECT_IVL { 18 } sub ZMQ_RECONNECT_IVL_MAX { 21 } sub ZMQ_RECONNECT_STOP { 109 } sub ZMQ_RECONNECT_STOP_AFTER_DISCONNECT { 3 } sub ZMQ_RECONNECT_STOP_CONN_REFUSED { 1 } sub ZMQ_RECONNECT_STOP_HANDSHAKE_FAILED { 2 } sub ZMQ_RECOVERY_IVL { 9 } sub ZMQ_RECOVERY_IVL_MSEC { 20 } sub ZMQ_REP { 4 } sub ZMQ_REQ { 3 } sub ZMQ_REQ_CORRELATE { 52 } sub ZMQ_REQ_RELAXED { 53 } sub ZMQ_ROUTER { 6 } sub ZMQ_ROUTER_HANDOVER { 56 } sub ZMQ_ROUTER_MANDATORY { 33 } sub ZMQ_ROUTER_NOTIFY { 97 } sub ZMQ_ROUTER_RAW { 41 } sub ZMQ_ROUTING_ID { 5 } sub ZMQ_SCATTER { 17 } sub ZMQ_SERVER { 12 } sub ZMQ_SHARED { 3 } sub ZMQ_SNDBUF { 11 } sub ZMQ_SNDHWM { 23 } sub ZMQ_SNDMORE { 2 } sub ZMQ_SNDTIMEO { 28 } sub ZMQ_SOCKET_LIMIT { 3 } sub ZMQ_SOCKS_PASSWORD { 100 } sub ZMQ_SOCKS_PROXY { 68 } sub ZMQ_SOCKS_USERNAME { 99 } sub ZMQ_SRCFD { 2 } sub ZMQ_STREAM { 11 } sub ZMQ_STREAMER { 1 } sub ZMQ_STREAM_NOTIFY { 73 } sub ZMQ_SUB { 2 } sub ZMQ_SUBSCRIBE { 6 } sub ZMQ_SWAP { 3 } sub ZMQ_TCP_ACCEPT_FILTER { 38 } sub ZMQ_TCP_KEEPALIVE { 34 } sub ZMQ_TCP_KEEPALIVE_CNT { 35 } sub ZMQ_TCP_KEEPALIVE_IDLE { 36 } sub ZMQ_TCP_KEEPALIVE_INTVL { 37 } sub ZMQ_TCP_MAXRT { 80 } sub ZMQ_THREAD_AFFINITY_CPU_ADD { 7 } sub ZMQ_THREAD_AFFINITY_CPU_REMOVE { 8 } sub ZMQ_THREAD_NAME_PREFIX { 9 } sub ZMQ_THREAD_PRIORITY { 3 } sub ZMQ_THREAD_SAFE { 81 } sub ZMQ_THREAD_SCHED_POLICY { 4 } sub ZMQ_TOS { 57 } sub ZMQ_TYPE { 16 } sub ZMQ_UNSUBSCRIBE { 7 } sub ZMQ_USE_FD { 89 } sub ZMQ_VMCI_BUFFER_MAX_SIZE { 87 } sub ZMQ_VMCI_BUFFER_MIN_SIZE { 86 } sub ZMQ_VMCI_BUFFER_SIZE { 85 } sub ZMQ_VMCI_CONNECT_TIMEOUT { 88 } sub ZMQ_VSM { 32 } sub ZMQ_WSS_CERT_PEM { 104 } sub ZMQ_WSS_HOSTNAME { 106 } sub ZMQ_WSS_KEY_PEM { 103 } sub ZMQ_WSS_TRUST_PEM { 105 } sub ZMQ_WSS_TRUST_SYSTEM { 107 } sub ZMQ_XPUB { 9 } sub ZMQ_XPUB_MANUAL { 71 } sub ZMQ_XPUB_MANUAL_LAST_VALUE { 98 } sub ZMQ_XPUB_NODROP { 69 } sub ZMQ_XPUB_VERBOSE { 40 } sub ZMQ_XPUB_VERBOSER { 78 } sub ZMQ_XPUB_WELCOME_MSG { 72 } sub ZMQ_XREP { 6 } sub ZMQ_XREQ { 5 } sub ZMQ_XSUB { 10 } sub ZMQ_ZAP_DOMAIN { 55 } sub ZMQ_ZAP_ENFORCE_DOMAIN { 93 } sub ZMQ_ZERO_COPY_RECV { 10 } sub zmq_msg_t_size { 128 } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::Constants - Generated module of zmq constants. All constants, all versions. =head1 VERSION version 1.19 =head1 SYNOPSIS use ZMQ::FFI::Constants qw(ZMQ_LINGER ZMQ_FD); # or use ZMQ::FFI::Constants q(:all) =head1 DESCRIPTION This module includes every zmq constant from every stable version of zeromq. Currently that is v2.1.0-v4.3.4. It was generated using the zeromq2-x, zeromq3-x, zeromq4-x, zeromq4-1, and libzmq git repos at L. =head1 SEE ALSO =over 4 =item * L =back =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ2/0000755000000000000000000000000014463157020013567 5ustar rootrootZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ2/Socket.pm0000644000000000000000000003100614463157020015355 0ustar rootroot# # Module Generated by Template::Tiny on Fri Aug 4 11:16:27 UTC 2023 # package ZMQ::FFI::ZMQ2::Socket; $ZMQ::FFI::ZMQ2::Socket::VERSION = '1.19'; use FFI::Platypus; use FFI::Platypus::Buffer; use FFI::Platypus::Memory qw(malloc free memcpy); use Carp qw(croak carp); use Try::Tiny; use ZMQ::FFI::ZMQ2::Raw; use ZMQ::FFI::Custom::Raw; use ZMQ::FFI::Constants qw(:all); use ZMQ::FFI::Util qw(current_tid); 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) { ZMQ::FFI::Custom::Raw::load($self->soname); ZMQ::FFI::ZMQ2::Raw::load($self->soname); $FFI_LOADED = 1; } # 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); } sub connect { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->connect($endpoint)'; } $self->check_error( 'zmq_connect', zmq_connect($self->socket_ptr, $endpoint) ); } sub disconnect { my ($self) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->bad_version( $self->verstr, "disconnect not available in zmq 2.x" ); } sub bind { my ($self, $endpoint) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } unless ($endpoint) { croak 'usage: $socket->bind($endpoint)' } $self->check_error( 'zmq_bind', zmq_bind($self->socket_ptr, $endpoint) ); } sub unbind { my ($self) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->bad_version( $self->verstr, "unbind not available in zmq 2.x" ); } sub send { # 0: self # 1: data # 2: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } 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_ptr, $_[0]->{"_zmq_msg_t"}, $_[2] // 0) ) { $_[0]->{last_errno} = zmq_errno(); if ($_[0]->die_on_error) { $_[0]->fatal('zmq_send'); } return; } } sub send_multipart { # 0: self # 1: partsref # 2: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } 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 { # 0: self # 1: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $_[0]->{last_errno} = 0; if ( -1 == zmq_recv($_[0]->socket_ptr, $_[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 recv_multipart { # 0: self # 1: flags if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } 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 { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_FD, 'int'); } sub get_linger { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_LINGER, 'int'); } sub set_linger { my ($self, $linger) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_LINGER, 'int', $linger); } sub get_identity { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_IDENTITY, 'binary'); } sub set_identity { my ($self, $id) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_IDENTITY, 'binary', $id); } sub subscribe { my ($self, $topic) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_SUBSCRIBE, 'binary', $topic); } sub unsubscribe { my ($self, $topic) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_UNSUBSCRIBE, 'binary', $topic); } sub has_pollin { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLIN; } sub has_pollout { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLOUT; } sub get { my ($self, $opt, $opt_type) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } my $optval; my $optval_len; for ($opt_type) { if ($_ =~ /^(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_ptr, $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); } } elsif ($_ eq 'int') { $optval_len = $self->sockopt_sizes->{'int'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } elsif ($_ eq 'int64_t') { $optval_len = $self->sockopt_sizes->{'sint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } elsif ($_ eq 'uint64_t') { $optval_len = $self->sockopt_sizes->{'uint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_uint64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } else { croak "unknown type $opt_type"; } } if ($optval ne '') { return $optval; } return; } sub set { my ($self, $opt, $opt_type, $optval) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } for ($opt_type) { if ($_ =~ /^(binary|string)$/) { my ($optval_ptr, $optval_len) = scalar_to_buffer($optval); $self->check_error( 'zmq_setsockopt', zmq_setsockopt_binary( $self->socket_ptr, $opt, $optval_ptr, $optval_len ) ); } elsif ($_ eq 'int') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'int'} ) ); } elsif ($_ eq 'int64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'sint64'} ) ); } elsif ($_ eq 'uint64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_uint64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'uint64'} ) ); } else { croak "unknown type $opt_type"; } } return; } sub close { my ($self) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } # don't try to cleanup socket cloned from another thread return unless $self->_tid == current_tid(); # don't try to cleanup socket copied from another process (fork) return unless $self->_pid == $$; $self->check_error( 'zmq_msg_close', zmq_msg_close($self->_zmq_msg_t) ); $self->check_error( 'zmq_close', zmq_close($self->socket_ptr) ); $self->socket_ptr(-1); } sub monitor { my ($self) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->bad_version( $self->verstr, "monitor not available in zmq 2.x" ); } sub recv_event { my ($self) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->bad_version( $self->verstr, "recv_event not available in zmq 2.x" ); } sub DEMOLISH { my ($self) = @_; # remove ourselves from the context object so that we dont leak $self->context->_remove_socket($self) if (defined $self->context); return if $self->socket_ptr == -1; $self->close(); } 1; # vim:ft=perl __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ2::Socket =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ2/Context.pm0000644000000000000000000001100514463157020015546 0ustar rootroot# # Module Generated by Template::Tiny on Fri Aug 4 11:16:27 UTC 2023 # package ZMQ::FFI::ZMQ2::Context; $ZMQ::FFI::ZMQ2::Context::VERSION = '1.19'; use FFI::Platypus; use ZMQ::FFI::Util qw(zmq_soname current_tid); use ZMQ::FFI::Constants qw(:all); use ZMQ::FFI::ZMQ2::Socket; use ZMQ::FFI::ZMQ2::Raw; use ZMQ::FFI::Custom::Raw; use Try::Tiny; use Scalar::Util qw(weaken); use Moo; use namespace::clean; with qw( ZMQ::FFI::ContextRole ZMQ::FFI::ErrorHelper ZMQ::FFI::Versioner ); my $FFI_LOADED; sub BUILD { my ($self) = @_; unless ($FFI_LOADED) { ZMQ::FFI::Custom::Raw::load($self->soname); ZMQ::FFI::ZMQ2::Raw::load($self->soname); $FFI_LOADED = 1; } $self->init() } has '+threads' => ( default => 1, ); sub init { my ($self) = @_; if ($self->has_max_sockets) { $self->bad_version( $self->verstr, 'max_sockets option not available in zmq 2.x', 'use_die', ) } try { $self->context_ptr( zmq_init($self->threads) ); $self->check_null('zmq_init', $self->context_ptr); } catch { $self->context_ptr(-1); die $_; }; } sub get { my ($self) = @_; $self->bad_version( $self->verstr, "getting ctx options not available in zmq 2.x" ); } sub set { my ($self) = @_; $self->bad_version( $self->verstr, "setting ctx options not available in zmq 2.x" ); } sub socket { my ($self, $type) = @_; my $socket; try { my $socket_ptr = zmq_socket($self->context_ptr, $type); $self->check_null('zmq_socket', $socket_ptr); $socket = ZMQ::FFI::ZMQ2::Socket->new( socket_ptr => $socket_ptr, context => $self, # this will become a weak ref type => $type, soname => $self->soname, ); } catch { die $_; }; # add the socket to the socket hash $self->_add_socket($socket); return $socket; } sub proxy { my ($self, $frontend, $backend, $capture) = @_; if ($capture){ $self->bad_version( $self->verstr, "capture socket not supported in zmq 2.x" ); } $self->check_error( 'zmq_device', zmq_device(ZMQ_STREAMER, $frontend->socket_ptr, $backend->socket_ptr) ); } sub device { my ($self, $type, $frontend, $backend) = @_; $self->check_error( 'zmq_device', zmq_device($type, $frontend->socket_ptr, $backend->socket_ptr) ); } sub destroy { my ($self) = @_; return if $self->context_ptr == -1; # don't try to cleanup context cloned from another thread return unless $self->_tid == current_tid(); # don't try to cleanup context copied from another process (fork) return unless $self->_pid == $$; $self->check_error( 'zmq_term', zmq_term($self->context_ptr) ); $self->context_ptr(-1); } sub curve_keypair { my ($self) = @_; $self->bad_version( $self->verstr, "curve_keypair not available in < zmq 4.x" ); } sub z85_encode { my ($self) = @_; $self->bad_version( $self->verstr, "z85_encode not available in < zmq 4.x" ); } sub z85_decode { my ($self) = @_; $self->bad_version( $self->verstr, "z85_decode not available in < zmq 4.x" ); } sub has_capability { my ($self) = @_; $self->bad_version( $self->verstr, "has_capability not available in < zmq 4.1" ); } sub _add_socket { my ($self, $socket) = @_; weaken($self->sockets->{$socket} = $socket); } sub _remove_socket { my ($self, $socket) = @_; delete($self->sockets->{$socket}); } sub DEMOLISH { my ($self) = @_; return if $self->context_ptr == -1; # check defined to guard against # undef objects during global destruction if (defined $self->sockets) { for my $socket_k (keys %{$self->sockets}) { my $socket = $self->_remove_socket($socket_k); $socket->close() if defined $socket && $socket->socket_ptr != -1; } } $self->destroy(); } 1; # vim:ft=perl __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ2::Context =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/lib/ZMQ/FFI/ZMQ2/Raw.pm0000644000000000000000000000627614463157020014671 0ustar rootrootpackage ZMQ::FFI::ZMQ2::Raw; $ZMQ::FFI::ZMQ2::Raw::VERSION = '1.19'; use FFI::Platypus; sub load { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname // 'libzmq.so' ); my $target = caller; $ffi->attach( # void *zmq_init(int io_threads) ['zmq_init' => "${target}::zmq_init"] => ['int'] => 'pointer' ); $ffi->attach( # void *zmq_socket(void *context, int type) ['zmq_socket' => "${target}::zmq_socket"] => ['pointer', 'int'] => 'pointer' ); $ffi->attach( # int zmq_device(int device, const void *front, const void *back) ['zmq_device' => "${target}::zmq_device"] => ['int', 'pointer', 'pointer'] => 'int' ); $ffi->attach( # int zmq_term(void *context) ['zmq_term' => "${target}::zmq_term"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_send(void *socket, zmq_msg_t *msg, int flags) ['zmq_send' => "${target}::zmq_send"] => ['pointer', 'pointer', 'int'] => 'int' ); $ffi->attach( # int zmq_recv(void *socket, zmq_msg_t *msg, int flags) ['zmq_recv' => "${target}::zmq_recv"] => ['pointer', 'pointer', 'int'] => 'int' ); $ffi->attach( # int zmq_connect(void *socket, const char *endpoint) ['zmq_connect' => "${target}::zmq_connect"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_bind(void *socket, const char *endpoint) ['zmq_bind' => "${target}::zmq_bind"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_msg_init(zmq_msg_t *msg) ['zmq_msg_init' => "${target}::zmq_msg_init"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_msg_init_size(zmq_msg_t *msg, size_t size) ['zmq_msg_init_size' => "${target}::zmq_msg_init_size"] => ['pointer', 'int'] => 'int' ); $ffi->attach( # size_t zmq_msg_size(zmq_msg_t *msg) ['zmq_msg_size' => "${target}::zmq_msg_size"] => ['pointer'] => 'int' ); $ffi->attach( # void *zmq_msg_data(zmq_msg_t *msg) ['zmq_msg_data' => "${target}::zmq_msg_data"] => ['pointer'] => 'pointer' ); $ffi->attach( # int zmq_msg_close(zmq_msg_t *msg) ['zmq_msg_close' => "${target}::zmq_msg_close"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_close(void *socket) ['zmq_close' => "${target}::zmq_close"] => ['pointer'] => 'int' ); $ffi->attach( # const char *zmq_strerror(int errnum) ['zmq_strerror' => "${target}::zmq_strerror"] => ['int'] => 'string' ); $ffi->attach( # int zmq_errno(void) ['zmq_errno' => "${target}::zmq_errno"] => [] => 'int' ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ2::Raw =head1 VERSION version 1.19 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2023 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 ZMQ-FFI-1.19/README.md0000644000000000000000000000735314463157020012504 0ustar rootroot# ZMQ::FFI [![Build Status](https://api.travis-ci.org/zeromq/perlzmq.svg?branch=master)](https://travis-ci.org/zeromq/perlzmq) ## version agnostic Perl bindings for ØMQ using ffi ## ZMQ::FFI exposes a high level, transparent, OO interface to zeromq independent of the underlying libzmq version. Where semantics differ, it will dispatch to the appropriate backend for you. As it uses ffi, there is no dependency on XS or compilation. ZMQ::FFI is implemented using [FFI::Platypus](https://github.com/plicease/FFI-Platypus). ### EXAMPLES ### #### send/recv #### ```perl use 5.012; use ZMQ::FFI qw(ZMQ_REQ ZMQ_REP); my $endpoint = "ipc://zmq-ffi-$$"; my $ctx = ZMQ::FFI->new(); my $s1 = $ctx->socket(ZMQ_REQ); $s1->connect($endpoint); my $s2 = $ctx->socket(ZMQ_REP); $s2->bind($endpoint); $s1->send('ohhai'); say $s2->recv(); # ohhai ``` #### pub/sub #### ```perl use 5.012; use ZMQ::FFI qw(ZMQ_PUB ZMQ_SUB); use Time::HiRes q(usleep); my $endpoint = "ipc://zmq-ffi-$$"; my $ctx = ZMQ::FFI->new(); my $s = $ctx->socket(ZMQ_SUB); my $p = $ctx->socket(ZMQ_PUB); $s->connect($endpoint); $p->bind($endpoint); # all topics { $s->subscribe(''); until ($s->has_pollin) { # compensate for slow subscriber usleep 100_000; $p->send('ohhai'); } say $s->recv(); # ohhai $s->unsubscribe(''); } # specific topics { $s->subscribe('topic1'); $s->subscribe('topic2'); until ($s->has_pollin) { usleep 100_000; $p->send('topic1 ohhai'); $p->send('topic2 ohhai'); } while ($s->has_pollin) { say join ' ', $s->recv(); # topic1 ohhai # topic2 ohhai } } ``` #### multipart #### ```perl use 5.012; use ZMQ::FFI qw(ZMQ_DEALER ZMQ_ROUTER); my $endpoint = "ipc://zmq-ffi-$$"; my $ctx = ZMQ::FFI->new(); my $d = $ctx->socket(ZMQ_DEALER); $d->set_identity('dealer'); my $r = $ctx->socket(ZMQ_ROUTER); $d->connect($endpoint); $r->bind($endpoint); $d->send_multipart([qw(ABC DEF GHI)]); say join ' ', $r->recv_multipart; # dealer ABC DEF GHI ``` #### nonblocking #### ```perl use 5.012; use ZMQ::FFI qw(ZMQ_PUSH ZMQ_PULL); use AnyEvent; use EV; my $endpoint = "ipc://zmq-ffi-$$"; my $ctx = ZMQ::FFI->new(); my @messages = qw(foo bar baz); my $pull = $ctx->socket(ZMQ_PULL); $pull->bind($endpoint); my $fd = $pull->get_fd(); my $recv = 0; my $w = AE::io $fd, 0, sub { while ( $pull->has_pollin ) { say $pull->recv(); # foo, bar, baz $recv++; if ($recv == 3) { EV::break(); } } }; my $push = $ctx->socket(ZMQ_PUSH); $push->connect($endpoint); my $sent = 0; my $t; $t = AE::timer 0, .1, sub { $push->send($messages[$sent]); $sent++; if ($sent == 3) { undef $t; } }; EV::run(); ``` #### specifying versions #### ```perl use ZMQ::FFI; # 2.x context my $ctx = ZMQ::FFI->new( soname => 'libzmq.so.1' ); my ($major, $minor, $patch) = $ctx->version; # 3.x context my $ctx = ZMQ::FFI->new( soname => 'libzmq.so.3' ); my ($major, $minor, $patch) = $ctx->version; ``` ### INSTALL ### cpanm -v ZMQ::FFI ### BUILD ### A docker image is provided with a pre-configured testing environment. To test the module: ./docker-run dzil test To build a dist tarball: ./docker-run dzil build To clean build artifacts: ./docker-run dzil clean Tests will run against every stable version of zeromq as well as master. If you would like an interactive shell inside the container run `./docker-shell` If you would prefer a native local setup refer to the Dockerfile and translate the setup steps accordingly for your distribution/platform (I personally use the docker container, and this is also how tests run under Travis). ### DOCUMENTATION ### https://metacpan.org/module/ZMQ::FFI ZMQ-FFI-1.19/bench/0000755000000000000000000000000014463157020012274 5ustar rootrootZMQ-FFI-1.19/bench/zmq-bench.c0000644000000000000000000000122114463157020014320 0ustar rootroot#include #include #include #include #include #include int main(void) { void *ctx = zmq_ctx_new(); assert(ctx); void *socket = zmq_socket(ctx, ZMQ_PUB); assert(socket); assert( -1 != zmq_bind(socket, "ipc:///tmp/zmq-bench-c") ); int major, minor, patch; zmq_version(&major, &minor, &patch); printf("C ZMQ Version: %d.%d.%d\n", major, minor, patch); int i; for ( i = 0; i < (10 * 1000 * 1000); i++ ) { assert( -1 != zmq_send(socket, "c", 1, 0) ); } printf("Sent %d messages\n", i); zmq_close(socket); zmq_ctx_destroy(ctx); } ZMQ-FFI-1.19/bench/zmq-bench-subcriber.pl0000644000000000000000000000124114463157020016471 0ustar rootrootuse 5.012; use warnings; use ZMQ::FFI qw(ZMQ_SUB); use Try::Tiny; my $count = 0; $SIG{USR1} = sub { say "received $count messages"; }; $SIG{USR2} = sub { say "resetting message count"; $count = 0; }; say "'kill -USR1 $$' to print current message count"; say "'kill -USR2 $$' to reset message count"; my $ctx = ZMQ::FFI->new(); my $s = $ctx->socket(ZMQ_SUB); $s->connect('ipc:///tmp/zmq-bench-c'); $s->connect('ipc:///tmp/zmq-bench-xs'); $s->connect('ipc:///tmp/zmq-bench-ffi'); $s->subscribe(''); my $r; while (1) { try { $r = $s->recv(); $count++; } catch { croak $_ unless $_ =~ m/Interrupted system call/; }; } ZMQ-FFI-1.19/bench/zmq-bench.pl0000644000000000000000000000333314463157020014517 0ustar rootrootuse warnings; use 5.012; use FFI::Platypus::Declare; use ZMQ::LibZMQ3; use ZMQ::FFI::Constants qw(:all); use Benchmark qw(:all); lib 'libzmq.so'; attach( ['zmq_ctx_new' => 'zmqffi_ctx_new'] => [] => 'pointer' ); attach( ['zmq_socket' => 'zmqffi_socket'] => ['pointer', 'int'] => 'pointer' ); attach( ['zmq_bind' => 'zmqffi_bind'] => ['pointer', 'string'] => 'int' ); attach( ['zmq_send' => 'zmqffi_send'] => ['pointer', 'string', 'size_t', 'int'] => 'int' ); attach( ['zmq_version' => 'zmqffi_version'] => ['int*', 'int*', 'int*'] => 'void' ); my $ffi_ctx = zmqffi_ctx_new(); die 'ffi ctx error' unless $ffi_ctx; my $ffi_socket = zmqffi_socket($ffi_ctx, ZMQ_PUB); die 'ffi socket error' unless $ffi_socket; my $rv; $rv = zmqffi_bind($ffi_socket, "ipc:///tmp/zmq-bench-ffi"); die 'ffi bind error' if $rv == -1; my $xs_ctx = zmq_ctx_new(); die 'xs ctx error' unless $xs_ctx; my $xs_socket = zmq_socket($xs_ctx, ZMQ_PUB); die 'xs socket error' unless $xs_socket; $rv = zmq_bind($xs_socket, "ipc:///tmp/zmq-bench-xs"); die 'xs bind error' if $rv == -1; my ($major, $minor, $patch); zmqffi_version(\$major, \$minor, \$patch); say "FFI ZMQ Version: " . join(".", $major, $minor, $patch); say "XS ZMQ Version: " . join(".", ZMQ::LibZMQ3::zmq_version()); # for (1..10_000_000) { # # die 'xs send error ' if -1 == zmq_send($xs_socket, 'xs', 2, 0); # die 'ffi send error' if -1 == zmqffi_send($ffi_socket, 'ffi', 3, 0); # } my $r = timethese 1_000_000, { 'XS' => sub { die 'xs send error ' if -1 == zmq_send($xs_socket, 'xs', 2, 0); }, 'FFI' => sub { die 'ffi send error' if -1 == zmqffi_send($ffi_socket, 'ffi', 3, 0); }, }; cmpthese($r); ZMQ-FFI-1.19/weaver.ini0000644000000000000000000000005614463157020013210 0ustar rootroot[@Default] [-Transformer] transformer = List ZMQ-FFI-1.19/Changes0000644000000000000000000001661214463157020012516 0ustar rootroot 1.19 2023-08-04 11:16:25+00:00 UTC 1.18 2022-03-21 10:48:44+00:00 UTC - New maintainer @ghenry - welcome and thank you! - Add MSWin32 support (GH#47 - thanks @zmughal!) - Add zmq_socket_monitor support (GH#46 - thanks @potatogim!) - Add z85_encoding support (GH#43 - thanks @juddtaylor!) - Document contributors - Update repository info. Now officially part of the zeromq project at https://github.com/zeromq/perlzmq - Have examples and scripts use 5.12 as minimum version, which enables strict by default 1.17 2019-03-14 04:05:15+00:00 UTC 1.16_01 2019-03-13 03:40:02+00:00 UTC (TRIAL RELEASE) - Need FFI::Platypus specified as a configure dependency (GH#42 - thanks @eserte) 1.15 2019-03-03 10:14:00+00:00 UTC - Bump FFI::Platypus dependency version to 0.86 https://github.com/Perl5-FFI/FFI-Platypus/issues/117 - Fix t/device.t hang, seems to be same cause/fix as GH#37 - Update ZMQ::FFI::Constants pod to also list libzmq as one of the repos used - Don't prune constants generation script from release tarball 1.14 2019-02-28 18:49:49+00:00 UTC - The ZMQ::FFI::Constants generation script wasn't using stable releases tagged in the libzmq main repo, this is fixed - FFI::TinyCC is no longer an author dep and has been replaced by a docker based solution for generating ZMQ::FFI::Constants, including calculating zmq_msg_t sizes - Fix potential memleak around socket cleanup (GH#33 - thanks @rhrhunter!) - Use string literals for matching option types (GH#30 - thanks @bbkr) 1.12 2019-02-26 05:16:15-05:00 America/New_York - Fix t/proxy.t hang (GH#37) 1.11 2016-01-10 19:27:05-05:00 America/New_York - Fix bareword error in closed_socket.t (GH#27 - thanks @rhrhunter) 1.10 2016-01-09 15:50:59-05:00 America/New_York - support importing zmq constants directly through ZMQ::FFI (GH#24) - don't execute operations on closed sockets and emit appropriate warnings (GH#23) 1.09 2015-12-09 04:55:20-06:00 America/Chicago - add more robust cleanup handling for ooo global destruction scenarios. 1.08 2015-11-07 10:47:10-06:00 America/Chicago - Fix cleanup handling when using Perl threads 1.07 2015-09-19 12:38:32-05:00 America/Chicago - Add 4.1 to xt/test_versions.sh - Add missing 4.1 stable constants. Update constants generation script to handle hex constant values. - Add workaround for hang in device.t and proxy.t 1.06 2015-03-28 11:30:15-05:00 America/Chicago - Update FreeBSD check 1.05_02 2015-03-28 03:31:38-05:00 America/Chicago 1.05_01 2015-03-28 02:52:01-05:00 America/Chicago 1.04 2015-03-24 03:02:20-05:00 America/Chicago - require FFI::Platypus 0.33 which fixes potential segfaults during global destruction (GH#19) - don't install on unthreaded BSD perls (GH#13) - more performance improvements, incl. 30% faster recv rate in some tests see 83f0013, f834fe9, and 394e164 - use a default linger of 0 (default used by czmq/jzmq) - don't clobber user linger value (GH#18) - properly localize redefines in tests - fix cleanup of ctx/sockets created in forked children 1.03 2015-03-16 04:47:24-05:00 America/Chicago - add alternative (non-exceptional) error handling semantics - fix socket files being left around after device.t and proxy.t - misc doc reformatting and rewording - don't use EV in fd.t 1.02 2015-03-12 04:51:14-05:00 America/Chicago - fix cleanup handling of inherited contexts/sockets in forked childen - don't include datetime in generated Constants module - fix pointer pack warning in ZMQ2 backend 1.01 2015-03-11 00:50:39-05:00 America/Chicago - Require Math::BigInt 1.997 or newer to resolve integer overflow bug (GH#14 - thanks @plicease!) - Perl v5.10 is now the official minimum version supported 1.00 2015-03-09 00:54:41-05:00 America/Chicago - switch to FFI::Platypus on the backend. FFI::Platypus provides the ability to bind ffi functions as first class Perl xsubs, resulting in dramatic performance gains. - optimize the Perl code in general, especially the send/recv hot spots - require Class::XSAccessor, which substantially improves Moo accessor performance - don't test against dev Perl on travis for now, seems to be busted 0.19 2015-03-04 01:42:16-06:00 America/Chicago - use dzil FFI::CheckLib plugin to properly report NA on CPAN tester boxes without libzmq - test against dev perl in addition to stable on travis 0.18 2015-02-25 07:30:20-06:00 America/Chicago - linger default has changed back to -1 for libzmq all versions - add travis tests for Perl 5.20 - $! will not be localized by default when stringified in Perl 5.22 and beyond, and needs to be explicitly localized in the tests (GH#12) 0.17 2014-11-08 22:31:25-06:00 America/Chicago - add zmq_device and zmq_proxy functionality (GH#10, GH#11 - thanks @semifor) - add libzmq.so.4 to list of sonames checked - linger default is 2000 circa libzmq 4.2 0.16 2014-09-13 17:20:05-05:00 America/Chicago - generate zmq_msg_t size, don't hardcode it (GH#9 - thanks @parth-j-gandhi!) - test against libzmq dev repo in addition to stable 0.15 2014-08-15 20:39:39 America/Chicago - Apply flags correctly in multipart sends (GH#8 - thanks @shripchenko) 0.14 2014-07-06 00:39:20 America/Chicago - add disconnect POD 0.13 2014-07-05 17:03:08 America/Chicago - add zmq_disconnect and zmq_unbind bindings (GH#7) 0.12 2014-03-29 17:48:45 America/Chicago - fix binary/string option handling (e.g. ZMQ_LAST_ENDPOINT) 0.11 2014-02-17 19:50:14 America/Chicago - works on OS X now (GH#6 - thanks @wjackson!) - mucho refactor and code reorg 0.10 2014-02-14 20:27:36 America/Chicago - Implicitly use system libc by passing undef as soname to FFI::Raw Requires FFI::Raw >= 0.26 0.09 2014-01-29 08:07:12 America/Chicago - use correct pack type for zmq_version - use appropriate error function depending on the context - don't ship zmq constants generation script, which confuses CPAN 0.08 2014-01-19 01:19:49 America/Chicago - ZMQ_DONTWAIT is not necessary in examples & tests - Fix unicode bytes handling (GH#5) Thanks @klaus for test and code - Generate constants through 4.0.3 - ZMQ4 support added (GH#4) Thanks @klaus for test, code, and suggestions 0.07 2013-11-10 15:38:14 America/Chicago - Support 32bit Perls (GH#1) - Make tests locale aware (GH#2) 0.06 2013-10-08 07:53:53 America/Chicago - Fix socket/context DEMOLISH order bug 0.05 2013-10-07 01:47:00 America/Chicago - Minimum required Moo version is 1.003001 0.04 2013-10-06 22:29:35 America/Chicago - Use Moo instead of Moose - Support specifying soname at object creation - Add zmq_soname and zmq_version Util functions - If soname unspecified try all libzmq sonames before failing - Major code and doc refactor - add .travis.yml for Travis CI builds 0.03 2013-10-03 14:32:50 America/Chicago - Doc additions 0.02 2013-10-03 12:32:16 America/Chicago - Doc tweaks - Don't try to close/destroy sockets/contexts if creation failed 0.01 2013-10-03 10:10:05 America/Chicago - Initial release ZMQ-FFI-1.19/dist.ini0000644000000000000000000000557614463157020012676 0ustar rootrootname = ZMQ-FFI author = Dylan Cali license = Perl_5 copyright_holder = Dylan Cali [@Filter] -bundle = @Basic -remove = MakeMaker ; authordep Dist::Zilla::Plugin::FFI::CheckLib = 1.05 [FFI::CheckLib] lib = zmq alien = Alien::ZMQ::latest [MakeMaker::Awesome] delimiter = | header = |use FFI::Platypus; header = |# Can't currently support unthreaded BSD perls header = |# See GH #13 header = |my $badbsd; header = |if ($^O eq 'freebsd') { header = | (!grep /libthr/, `procstat -v $$`) && ($badbsd = 1); header = |} elsif ($^O =~ m/bsd/i) { header = | !FFI::Platypus->new(lib => [undef]) header = | ->find_symbol('pthread_self') header = | && ($badbsd = 1); header = |} header = |if ($badbsd) { header = | print "On BSD ZMQ::FFI requires a perl built to support threads."; header = | print " Can't continue\n"; header = | exit; header = |} [Git::NextVersion] version_regexp = ^(.+)$ [PkgVersion] [PodWeaver] [AutoPrereqs] skip = ^Sys::SigAction skip = ^Alien::ZMQ::latest [Prereqs / ConfigureRequires] FFI::Platypus = 0.86 [Prereqs / ConfigureSuggests] Alien::ZMQ::latest = 0.007 [Prereqs / RuntimeRequires] perl = 5.010 Moo = 1.004005 Class::XSAccessor = 1.18 Math::BigInt = 1.997 FFI::Platypus = 0.86 Import::Into = 1.002005 [Prereqs / RuntimeSuggests] Alien::ZMQ::latest = 0.007 [DynamicPrereqs / Sys::SigAction] -condition = isnt_os('MSWin32') -body = test_requires('Sys::SigAction', '0') [Run::BeforeBuild] run = perl scripts/gen_zmq_constants.pl run = perl -Ilib -I. scripts/gen_modules.pl [Run::Test] run = xt/test_versions.sh [Run::Clean] run = rm -f lib/ZMQ/FFI/Constants.pm run = rm -f lib/ZMQ/FFI/*/Context.pm run = rm -f lib/ZMQ/FFI/*/Socket.pm [NextRelease] [GitHub::Meta] repo = zeromq/perlzmq [MetaJSON] [MetaNoIndex] directory = t [Meta::Contributors] contributor = Dave Lambley contributor = Graham Ollis contributor = Klaus Ita contributor = Marc Mims contributor = Parth Gandhi contributor = Pawel Pabian contributor = Robert Hunter contributor = Sergey KHripchenko contributor = Slaven Rezic contributor = Whitney Jackson contributor = pipcet contributor = Judd Taylor contributor = Ji-Hyeon Gim contributor = Zaki Mughal contributor = Gavin Henry [Git::Commit] allow_dirty = Changes commit_msg = version => %v [Git::Tag] tag_format = %v tag_message = %v [Git::Check] allow_dirty = [Git::Push] [Clean] ; authordep Pod::Elemental::Transformer::List ; authordep Template::Tiny ; authordep Path::Class ; authordep FFI::Platypus ZMQ-FFI-1.19/Makefile.PL0000644000000000000000000001043714463157020013174 0ustar rootroot# This Makefile.PL for ZMQ-FFI was generated by # Dist::Zilla::Plugin::MakeMaker::Awesome 0.49. # Don't edit it but the dist.ini and plugins used to construct it. use strict; use warnings; # inserted by Dist::Zilla::Plugin::FFI::CheckLib 1.07 use FFI::CheckLib; check_lib_or_exit( alien => 'Alien::ZMQ::latest', lib => 'zmq', ); use ExtUtils::MakeMaker; use FFI::Platypus; # Can't currently support unthreaded BSD perls # See GH #13 my $badbsd; if ($^O eq 'freebsd') { (!grep /libthr/, `procstat -v $$`) && ($badbsd = 1); } elsif ($^O =~ m/bsd/i) { !FFI::Platypus->new(lib => [undef]) ->find_symbol('pthread_self') && ($badbsd = 1); } if ($badbsd) { print "On BSD ZMQ::FFI requires a perl built to support threads."; print " Can't continue\n"; exit; } my %WriteMakefileArgs = ( "ABSTRACT" => "version agnostic Perl bindings for zeromq using ffi", "AUTHOR" => "Dylan Cali ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "FFI::CheckLib" => "0.28", "FFI::Platypus" => "0.86" }, "DISTNAME" => "ZMQ-FFI", "LICENSE" => "perl", "NAME" => "ZMQ::FFI", "PREREQ_PM" => { "Carp" => 0, "Class::XSAccessor" => "1.18", "Exporter" => 0, "FFI::CheckLib" => 0, "FFI::Platypus" => "0.86", "FFI::Platypus::Buffer" => 0, "FFI::Platypus::Memory" => 0, "Import::Into" => "1.002005", "Math::BigInt" => "1.997", "Moo" => "1.004005", "Moo::Role" => 0, "Scalar::Util" => 0, "Sub::Exporter" => 0, "Try::Tiny" => 0, "bytes" => 0, "feature" => 0, "if" => 0, "namespace::clean" => 0, "strict" => 0, "threads" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "AnyEvent" => 0, "List::Util" => 0, "Math::BigInt" => "1.997", "POSIX" => 0, "Sub::Override" => 0, "Test::Deep" => 0, "Test::Exception" => 0, "Test::More" => 0, "Test::NoWarnings" => 0, "Test::Warnings" => 0, "Time::HiRes" => 0, "lib" => 0, "locale" => 0, "utf8" => 0 }, "VERSION" => "1.19", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "AnyEvent" => 0, "Carp" => 0, "Class::XSAccessor" => "1.18", "Exporter" => 0, "FFI::CheckLib" => 0, "FFI::Platypus" => "0.86", "FFI::Platypus::Buffer" => 0, "FFI::Platypus::Memory" => 0, "Import::Into" => "1.002005", "List::Util" => 0, "Math::BigInt" => "1.997", "Moo" => "1.004005", "Moo::Role" => 0, "POSIX" => 0, "Scalar::Util" => 0, "Sub::Exporter" => 0, "Sub::Override" => 0, "Test::Deep" => 0, "Test::Exception" => 0, "Test::More" => 0, "Test::NoWarnings" => 0, "Test::Warnings" => 0, "Time::HiRes" => 0, "Try::Tiny" => 0, "bytes" => 0, "feature" => 0, "if" => 0, "lib" => 0, "locale" => 0, "namespace::clean" => 0, "strict" => 0, "threads" => 0, "utf8" => 0, "warnings" => 0 ); # inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.040 if (isnt_os('MSWin32')) { test_requires('Sys::SigAction', '0') } unless ( eval { ExtUtils::MakeMaker->VERSION('6.63_03') } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); # inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.040 sub _add_prereq { my ($mm_key, $module, $version_or_range) = @_; $version_or_range ||= 0; warn "$module already exists in $mm_key (at version $WriteMakefileArgs{$mm_key}{$module}) -- need to do a sane metamerge!" if exists $WriteMakefileArgs{$mm_key}{$module} and $WriteMakefileArgs{$mm_key}{$module} ne '0' and $WriteMakefileArgs{$mm_key}{$module} ne $version_or_range; warn "$module already exists in FallbackPrereqs (at version $FallbackPrereqs{$module}) -- need to do a sane metamerge!" if exists $FallbackPrereqs{$module} and $FallbackPrereqs{$module} ne '0' and $FallbackPrereqs{$module} ne $version_or_range; $WriteMakefileArgs{$mm_key}{$module} = $FallbackPrereqs{$module} = $version_or_range; return; } sub isnt_os { foreach my $os (@_) { return 0 if $os eq $^O; } return 1; } sub test_requires { my ($module, $version_or_range) = @_; _add_prereq(TEST_REQUIRES => $module, $version_or_range); } ZMQ-FFI-1.19/scripts/0000755000000000000000000000000014463157020012704 5ustar rootrootZMQ-FFI-1.19/scripts/docker-push0000755000000000000000000000034014463157020015053 0ustar rootroot#!/bin/bash -e version=$1 if [ -z "$version" ]; then echo "docker-push " exit 1 fi for t in $version latest ubuntu; do docker push calid/perl-zmq-base:$t docker push calid/zmq-ffi-testenv:$t done ZMQ-FFI-1.19/scripts/docker-build0000755000000000000000000000062414463157020015200 0ustar rootroot#!/bin/bash -e version=$1 if [ -z "$version" ]; then echo "docker-build " exit 1 fi docker build scripts -f scripts/Dockerfile.perl-zmq-base \ -t calid/perl-zmq-base:$version \ -t calid/perl-zmq-base:latest \ -t calid/perl-zmq-base:ubuntu docker build . \ -t calid/zmq-ffi-testenv:$version \ -t calid/zmq-ffi-testenv:latest \ -t calid/zmq-ffi-testenv:ubuntu ZMQ-FFI-1.19/scripts/print_zmq_msg_size.c0000644000000000000000000000014014463157020016766 0ustar rootroot#include #include int main(void) { printf("%zu\n", sizeof(zmq_msg_t)); } ZMQ-FFI-1.19/scripts/Dockerfile.perl-zmq-base0000644000000000000000000000041414463157020017353 0ustar rootrootFROM ubuntu:latest ENV DEBIAN_FRONTEND=noninteractive RUN apt-get update \ && apt-get install -y gcc make libzmq5 openssl libssl-dev zlib1g-dev \ cpanminus \ && apt-get clean \ && rm -rf /var/lib/apt/lists/* /usr/local/share/man/* /usr/share/doc/* ZMQ-FFI-1.19/scripts/docker-test-install0000755000000000000000000000041214463157020016517 0ustar rootroot#!/bin/bash docker run --rm \ -v $(pwd):/zmq-ffi \ -w /zmq-ffi \ calid/zmq-ffi-testenv:ubuntu sh -c "dzil clean && dzil build" docker run --rm \ -v $(pwd):/zmq-ffi \ -w /zmq-ffi \ calid/perl-zmq-base:ubuntu sh -c "cpanm -v ZMQ-FFI-*.tar.gz" ZMQ-FFI-1.19/scripts/gen_zmq_constants.pl0000644000000000000000000001060714463157020017001 0ustar rootroot#!/usr/bin/env perl use strict; use warnings; use feature 'say'; use Path::Class qw(file dir); use List::Util q(max); use autodie qw(system); my $constants_pm = 'lib/ZMQ/FFI/Constants.pm'; say "Generating '$constants_pm'"; $constants_pm = file($constants_pm)->absolute; my @versions; my %zmq_constants; my $builddir = dir("$ENV{HOME}/.zmq-ffi"); my @repos = map { "zeromq$_" } qw(2-x 3-x 4-x 4-1); push @repos, 'libzmq'; # We need to iterate each stable version of each zmq mainline to get the # complete set of all zeromq constants across versions. Some sanity checking # is also done to verify constants weren't redefined in subsequent versions for my $r (@repos) { say "\nGetting releases for $r"; my $repo_dir = $builddir->subdir("$r"); if ( ! -d "$repo_dir" ) { say "$repo_dir doesn't exist"; my $repo_url = "https://github.com/zeromq/$r.git"; say "Cloning $repo_url to $repo_dir"; system("git clone -q $repo_url $repo_dir"); } chdir "$repo_dir"; for my $version (qx(git tag)) { chomp $version; say "Getting constants for $version"; push @versions, $version; my %constants = map { split '\s+' } grep { !/ZMQ_VERSION/ } # Skip ZMQ_GROUP_MAX_LENGTH. # # The value for ZMQ_GROUP_MAX_LENGTH changed from 15 to 255 between # libzmq versions v4.3.2 and v4.3.3. # # - , # - . # # This is for the RADIO-DISH protocol that was introduced as a # draft in v4.2.0 . grep { !/ZMQ_GROUP_MAX_LENGTH/ } grep { /\b(ZMQ_[^ ]+\s+(0x)?[0-9A-F]+)/; $_ = $1; } qx(git show $version:include/zmq.h); if ($version =~ m/^v3\./ && !defined($constants{ZMQ_EVENT_ALL})) { $constants{ZMQ_EVENT_ALL} = 65535; } while ( my ($constant,$value) = each %constants ) { # handle hex values if ( $value =~ m/^0x/ ) { $value = hex($value); } if ( exists $zmq_constants{$constant} && $constant !~ m/DFLT/ ) { my $oldvalue = $zmq_constants{$constant}->[0]; my $oldversion = $zmq_constants{$constant}->[1]; if ( $value != $oldvalue ) { die "$constant redefined in $version: " ."was $oldvalue since $oldversion, now $value"; } } else { $zmq_constants{$constant} = [$value, $version]; } } } chdir '..' } my @exports; my @subs; while ( my ($constant,$data) = each %zmq_constants ) { my $value = $data->[0]; push @exports, $constant; push @subs, "sub $constant { $value }"; } # Also add dynamically generated zmq_msg_t size. we use 2x the largest # size of zmq_msg_t among all zeromq versions, including dev. This # should hopefully be large enough to accomodate fluctuations in size # between releases. Note this assumes the generated zmq_msg_sizes file exists my @zmq_msg_sizes = file("$builddir/zmq_msg_size/zmq_msg_sizes") ->slurp(chomp => 1); my $zmq_msg_size = 2 * max(@zmq_msg_sizes); push @exports, 'zmq_msg_t_size'; push @subs, "sub zmq_msg_t_size { $zmq_msg_size }"; my $exports = join "\n", sort @exports; my $subs = join "\n", sort @subs; my $date = localtime; my $first = $versions[0]; my $latest = $versions[$#versions]; my $module = <<"END"; package ZMQ::FFI::Constants; # ABSTRACT: Generated module of zmq constants. All constants, all versions. # Generated using ZMQ versions $first-$latest use strict; use warnings; use Exporter 'import'; our \@EXPORT_OK = qw( $exports ); our %EXPORT_TAGS = (all => [\@EXPORT_OK]); $subs 1; __END__ =head1 SYNOPSIS use ZMQ::FFI::Constants qw(ZMQ_LINGER ZMQ_FD); # or use ZMQ::FFI::Constants q(:all) =head1 DESCRIPTION This module includes every zmq constant from every stable version of zeromq. Currently that is $first-$latest. It was generated using the zeromq2-x, zeromq3-x, zeromq4-x, zeromq4-1, and libzmq git repos at L. =head1 SEE ALSO =for :list * L END say "\nWriting module file"; $constants_pm->spew($module); say "Done!\n"; ZMQ-FFI-1.19/scripts/docker-release-shell0000755000000000000000000000045314463157020016626 0ustar rootroot#!/bin/bash docker run --rm -i -t \ -e SHELL=/bin/bash \ -v $(pwd):/zmq-ffi \ -v $HOME/.ssh:/root/.ssh \ -v $HOME/.pause:/root/.pause \ -v $HOME/.gitconfig:/root/.gitconfig \ -v $HOME/.gitignore:/root/.gitignore \ -w /zmq-ffi \ calid/zmq-ffi-testenv:ubuntu /bin/bash ZMQ-FFI-1.19/scripts/gen_modules.pl0000644000000000000000000000312514463157020015543 0ustar rootroot#!/usr/bin/env perl use warnings; use 5.012; use Template::Tiny; use Path::Class qw(file); use inc::ZMQ2::ContextWrappers; use inc::ZMQ2::SocketWrappers; use inc::ZMQ3::ContextWrappers; use inc::ZMQ3::SocketWrappers; use inc::ZMQ4::ContextWrappers; use inc::ZMQ4::SocketWrappers; use inc::ZMQ4_1::ContextWrappers; use inc::ZMQ4_1::SocketWrappers; my @wrappers; for my $zmqver (qw(ZMQ2 ZMQ3 ZMQ4 ZMQ4_1)) { my $context_wrapper = "inc::${zmqver}::ContextWrappers"; my $socket_wrapper = "inc::${zmqver}::SocketWrappers"; push @wrappers, $context_wrapper->new( zmqver => $zmqver ); push @wrappers, $socket_wrapper->new( zmqver => $zmqver ); } gen_module($_) for @wrappers; sub gen_module { my ($wrapper) = @_; my $socket_check = q(if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; }); my $api_wrappers = $wrapper->wrappers; my %tt_vars = ( date => split("\n", scalar(qx{date -u})), zmqver => $wrapper->zmqver, closed_socket_check => $socket_check, api_methods => $wrapper->api_methods, lib_imports => $wrapper->lib_imports, %$api_wrappers, ); my $input = $wrapper->template->slurp(); # Processing twice so template tokens used in # zmq function wrappers also get interoplated my $output; Template::Tiny->new->process(\$input, \%tt_vars, \$output); Template::Tiny->new->process(\$output, \%tt_vars, \$output); my $target = $wrapper->target; say "Generating '$target'"; $target->spew($output) } ZMQ-FFI-1.19/META.json0000644000000000000000000000660214463157020012642 0ustar rootroot{ "abstract" : "version agnostic Perl bindings for zeromq using ffi", "author" : [ "Dylan Cali " ], "dynamic_config" : 1, "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "ZMQ-FFI", "no_index" : { "directory" : [ "t" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "FFI::CheckLib" : "0.28", "FFI::Platypus" : "0.86" }, "suggests" : { "Alien::ZMQ::latest" : "0.007" } }, "develop" : { "requires" : { "Test::Exception" : "0", "Test::More" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Class::XSAccessor" : "1.18", "Exporter" : "0", "FFI::CheckLib" : "0", "FFI::Platypus" : "0.86", "FFI::Platypus::Buffer" : "0", "FFI::Platypus::Memory" : "0", "Import::Into" : "1.002005", "Math::BigInt" : "1.997", "Moo" : "1.004005", "Moo::Role" : "0", "Scalar::Util" : "0", "Sub::Exporter" : "0", "Try::Tiny" : "0", "bytes" : "0", "feature" : "0", "if" : "0", "namespace::clean" : "0", "perl" : "v5.10.0", "strict" : "0", "threads" : "0", "warnings" : "0" }, "suggests" : { "Alien::ZMQ::latest" : "0.007" } }, "test" : { "requires" : { "AnyEvent" : "0", "List::Util" : "0", "Math::BigInt" : "1.997", "POSIX" : "0", "Sub::Override" : "0", "Test::Deep" : "0", "Test::Exception" : "0", "Test::More" : "0", "Test::NoWarnings" : "0", "Test::Warnings" : "0", "Time::HiRes" : "0", "lib" : "0", "locale" : "0", "perl" : "v5.10.0", "utf8" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/zeromq/perlzmq/issues" }, "repository" : { "type" : "git", "url" : "git://github.com/zeromq/perlzmq.git", "web" : "https://github.com/zeromq/perlzmq" } }, "version" : "1.19", "x_contributors" : [ "Dave Lambley ", "Graham Ollis ", "Klaus Ita ", "Marc Mims ", "Parth Gandhi ", "Pawel Pabian ", "Robert Hunter ", "Sergey KHripchenko ", "Slaven Rezic ", "Whitney Jackson ", "pipcet ", "Judd Taylor ", "Ji-Hyeon Gim ", "Zaki Mughal ", "Gavin Henry " ], "x_generated_by_perl" : "v5.30.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.19" } ZMQ-FFI-1.19/docker-run0000755000000000000000000000015714463157020013217 0ustar rootroot#!/bin/bash docker run --rm \ -v $(pwd):/zmq-ffi \ -w /zmq-ffi \ calid/zmq-ffi-testenv:ubuntu "$@" ZMQ-FFI-1.19/META.yml0000644000000000000000000000375614463157020012501 0ustar rootroot--- abstract: 'version agnostic Perl bindings for zeromq using ffi' author: - 'Dylan Cali ' build_requires: AnyEvent: '0' List::Util: '0' Math::BigInt: '1.997' POSIX: '0' Sub::Override: '0' Test::Deep: '0' Test::Exception: '0' Test::More: '0' Test::NoWarnings: '0' Test::Warnings: '0' Time::HiRes: '0' lib: '0' locale: '0' perl: v5.10.0 utf8: '0' configure_requires: ExtUtils::MakeMaker: '0' FFI::CheckLib: '0.28' FFI::Platypus: '0.86' dynamic_config: 1 generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: ZMQ-FFI no_index: directory: - t requires: Carp: '0' Class::XSAccessor: '1.18' Exporter: '0' FFI::CheckLib: '0' FFI::Platypus: '0.86' FFI::Platypus::Buffer: '0' FFI::Platypus::Memory: '0' Import::Into: '1.002005' Math::BigInt: '1.997' Moo: '1.004005' Moo::Role: '0' Scalar::Util: '0' Sub::Exporter: '0' Try::Tiny: '0' bytes: '0' feature: '0' if: '0' namespace::clean: '0' perl: v5.10.0 strict: '0' threads: '0' warnings: '0' resources: bugtracker: https://github.com/zeromq/perlzmq/issues repository: git://github.com/zeromq/perlzmq.git version: '1.19' x_contributors: - 'Dave Lambley ' - 'Graham Ollis ' - 'Klaus Ita ' - 'Marc Mims ' - 'Parth Gandhi ' - 'Pawel Pabian ' - 'Robert Hunter ' - 'Sergey KHripchenko ' - 'Slaven Rezic ' - 'Whitney Jackson ' - 'pipcet ' - 'Judd Taylor ' - 'Ji-Hyeon Gim ' - 'Zaki Mughal ' - 'Gavin Henry ' x_generated_by_perl: v5.30.0 x_serialization_backend: 'YAML::Tiny version 1.73' ZMQ-FFI-1.19/t/0000755000000000000000000000000014463157020011460 5ustar rootrootZMQ-FFI-1.19/t/fd.t0000644000000000000000000000172214463157020012240 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use lib 't/lib'; use ZMQTest; if( ! ZMQTest->platform_zmq_fd_sockopt_is_fd ) { plan skip_all => 'Method get_fd() not implemented for platform'; } use AnyEvent; use ZMQ::FFI qw(ZMQ_PUSH ZMQ_PULL); my $endpoint = ZMQTest->endpoint("test-zmq-ffi-$$"); my @expected = qw(foo bar baz); my $ctx = ZMQ::FFI->new(); my $pull = $ctx->socket(ZMQ_PULL); $pull->bind($endpoint); my $fd = $pull->get_fd(); my $cv = AE::cv; my $recv = 0; my $w = AE::io $fd, 0, sub { while ($pull->has_pollin) { my $msg = $pull->recv(); is $msg, $expected[$recv], "got message $recv"; $recv++; if ($recv == 3) { $cv->send; } } }; my $push = $ctx->socket(ZMQ_PUSH); $push->connect($endpoint); my $t; my $sent = 0; $t = AE::timer 0, .1, sub { $push->send($expected[$sent]); $sent++; if ($sent == 3) { undef $t; } }; $cv->recv; done_testing; ZMQ-FFI-1.19/t/proxy.t0000644000000000000000000000247414463157020013035 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use lib 't/lib'; use ZMQTest; use ZMQ::FFI qw(ZMQ_PUSH ZMQ_PULL); use Time::HiRes q(usleep); use POSIX ":sys_wait_h"; if( ! ZMQTest->platform_can_fork ) { plan skip_all => 'fork(2) unavailable'; } my $server_address = ZMQTest->endpoint("test-zmq-ffi-$$-front"); my $worker_address = ZMQTest->endpoint("test-zmq-ffi-$$-back"); # Set up the proxy in its own process my $proxy = fork; die "fork failed: $!" unless defined $proxy; if ( $proxy == 0 ) { my $ctx = ZMQ::FFI->new(); my $front = $ctx->socket(ZMQ_PULL); $front->bind($server_address); my $back = $ctx->socket(ZMQ_PUSH); $back->bind($worker_address); $ctx->proxy($front, $back); warn "proxy exited: $!"; exit 0; } subtest 'proxy', sub { my $ctx = ZMQ::FFI->new(); my $server = $ctx->socket(ZMQ_PUSH); $server->connect($server_address); my $worker = $ctx->socket(ZMQ_PULL); $worker->connect($worker_address); my $message = 'ohhai'; $server->send($message); until ($worker->has_pollin) { # sleep for a 100ms to compensate for slow subscriber problem usleep 100_000; } my $payload = $worker->recv; is $payload, $message, "Message received"; kill TERM => $proxy; waitpid($proxy,0); }; done_testing; ZMQ-FFI-1.19/t/router-req.t0000644000000000000000000000207214463157020013753 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use lib 't/lib'; use ZMQTest; use ZMQ::FFI qw(ZMQ_ROUTER ZMQ_REQ); use Time::HiRes q(usleep); subtest 'router-req', sub { my $endpoint = ZMQTest->endpoint("test-zmq-ffi-$$"); my $ctx = ZMQ::FFI->new(); my $req = $ctx->socket(ZMQ_REQ); my $rtr = $ctx->socket(ZMQ_ROUTER); $req->connect($endpoint); $rtr->bind($endpoint); my $message = 'ohhai'; { $req->send($message); until ($rtr->has_pollin) { # sleep for a 100ms to compensate for slow subscriber problem usleep 100_000; } my ($identifier, $null, $payload) = $rtr->recv_multipart(); is $null, '', "Null is really null"; is $payload, $message, "Message received"; $rtr->send_multipart([$identifier, '', '' . reverse($payload)]); until ($req->has_pollin) { usleep 100_000; } my @result = $req->recv(); is reverse($result[0]), $message, "Message received by client"; } }; done_testing; ZMQ-FFI-1.19/t/lib/0000755000000000000000000000000014463157020012226 5ustar rootrootZMQ-FFI-1.19/t/lib/ZMQTest.pm0000644000000000000000000000252414463157020014076 0ustar rootrootpackage ZMQTest; # ABSTRACT: Test helper library =head1 CLASS METHODS =head2 platform_can_fork Returns true if platform can use L syscall. Returns false on C which does not have a real L. =cut sub platform_can_fork { return $^O ne 'MSWin32'; } =head2 platform_can_sigaction Returns true if platform can use L. Returns false on C which does not have L. =cut sub platform_can_sigaction { return $^O ne 'MSWin32'; } =head2 platform_zmq_fd_sockopt_is_fd Returns true if the ZeroMQ socket option C is a C runtime file descriptor (which is an C). Returns false on C where C is of type C (which is a C). =cut sub platform_zmq_fd_sockopt_is_fd { return $^O ne 'MSWin32'; } =head2 platform_can_transport_zmq_ipc Returns true if platform can use L transport. This is currently false on systems such as C because they do not support Unix domain sockets. =cut sub platform_can_transport_zmq_ipc { return $^O ne 'MSWin32'; } =head2 endpoint ZMQTest->endpoint($name) Returns an appropriate endpoint string that is supported on the current platform. =cut sub endpoint { my ($class, $name) = @_; if( $class->platform_can_transport_zmq_ipc ) { return "ipc:///tmp/$name"; } else { return "inproc://$name"; } } 1; ZMQ-FFI-1.19/t/send_recv.t0000644000000000000000000000127014463157020013615 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use lib 't/lib'; use ZMQTest; use ZMQ::FFI qw(ZMQ_REQ ZMQ_REP); my $endpoint = ZMQTest->endpoint("test-zmq-ffi-$$"); my $ctx = ZMQ::FFI->new( threads => 1 ); my $s1 = $ctx->socket(ZMQ_REQ); $s1->connect($endpoint); my $s2 = $ctx->socket(ZMQ_REP); $s2->bind($endpoint); $s1->send('ohhai'); is $s2->recv(), 'ohhai', 'received message'; $s1->close(); is $s1->socket_ptr, -1, 's1 socket ptr set to -1 after explicit close'; $s2->close(); is $s2->socket_ptr, -1, 's2 socket ptr set to -1 after explicit close'; $ctx->destroy(); is $ctx->context_ptr, -1, 'ctx ptr set to -1 after explicit destroy'; done_testing; ZMQ-FFI-1.19/t/linger.t0000644000000000000000000000142514463157020013127 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use ZMQ::FFI qw(ZMQ_REQ); my $ctx = ZMQ::FFI->new(); my $s = $ctx->socket(ZMQ_REQ); no strict qw/refs/; no warnings qw/redefine once/; my $fake_close = sub { my ($self) = @_; is $self->get_linger, 42, "user linger value honored during socket close"; # need to manually set linger & close # since we clobbered the real method $self->set_linger(0); my $class = ref $self; &{"$class\::zmq_close"}($self->socket_ptr); }; local *ZMQ::FFI::ZMQ2::Socket::close = $fake_close; local *ZMQ::FFI::ZMQ3::Socket::close = $fake_close; use strict; use warnings; is $s->get_linger, 0, "got default linger"; $s->set_linger(42); is $s->get_linger, 42, "linger is 42 after set"; undef $s; done_testing; ZMQ-FFI-1.19/t/z85_encoding.t0000644000000000000000000000313214463157020014140 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use Test::Exception; use ZMQ::FFI; use ZMQ::FFI::Constants qw(ZMQ_REQ ZMQ_REP ZMQ_CURVE_SERVER ZMQ_CURVE_SECRETKEY ZMQ_CURVE_PUBLICKEY ZMQ_CURVE_SERVERKEY); my $c = ZMQ::FFI->new(); my ($major, $minor) = $c->version(); if ($major == 4) { if ($minor >= 1) { if ($c->has_capability("curve")) { my ($encoded, $priv) = $c->curve_keypair; my $decoded = $c->z85_decode( $encoded ); my $recoded = $c->z85_encode( $decoded ); is $recoded, $encoded; } else { # zmq >= 4.1 - libsodium is not installed, do nothing } } else { # zmq == 4.0 - can't assume libsodium is installed or uninstalled # so we can't run the z85_encode() method # verify that has capability is not implemented before 4.1 throws_ok { $c->has_capability() } qr'has_capability not available', 'threw unimplemented error for < 4.1'; } } else { # zmq < 4.x - z85_encode / z85_decode and has capability are not implemented throws_ok { $c->z85_encode() } qr'z85_encode not available', 'threw unimplemented error in < 4.x'; throws_ok { $c->z85_decode() } qr'z85_decode not available', 'threw unimplemented error in < 4.x'; throws_ok { $c->has_capability() } qr'has_capability not available', 'threw unimplemented error for < 4.1'; } done_testing; ZMQ-FFI-1.19/t/device.t0000644000000000000000000000340514463157020013106 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use Test::Exception; use lib 't/lib'; use ZMQTest; use ZMQ::FFI qw(ZMQ_STREAMER ZMQ_PUSH ZMQ_PULL); use ZMQ::FFI::Util qw(zmq_version); use Time::HiRes q(usleep); use POSIX ":sys_wait_h"; if( ! ZMQTest->platform_can_fork ) { plan skip_all => 'fork(2) unavailable'; } my $server_address = ZMQTest->endpoint("test-zmq-ffi-$$-front"); my $worker_address = ZMQTest->endpoint("test-zmq-ffi-$$-back"); my $device; sub mkdevice { my $ctx = ZMQ::FFI->new(); my $front = $ctx->socket(ZMQ_PULL); $front->bind($server_address); my $back = $ctx->socket(ZMQ_PUSH); $back->bind($worker_address); $ctx->device(ZMQ_STREAMER, $front, $back); warn "device exited: $!"; exit 0; } my ($major) = zmq_version(); if ($major > 2) { throws_ok { mkdevice() } qr/zmq_device not available in zmq >= 3\.x/, 'zmq_device version error for zmq >= 3.x'; } else { # Set up the streamer device in its own process $device = fork; die "fork failed: $!" unless defined $device; if ( $device == 0 ) { mkdevice(); } } subtest 'device', sub { my $ctx = ZMQ::FFI->new(); if ($major > 2) { plan skip_all => 'zmq_device not available in zmq >= 3.x'; } my $server = $ctx->socket(ZMQ_PUSH); $server->connect($server_address); my $worker = $ctx->socket(ZMQ_PULL); $worker->connect($worker_address); my $message = 'ohhai'; $server->send($message); until ($worker->has_pollin) { # sleep for a 100ms to compensate for slow subscriber problem usleep 100_000; } my $payload = $worker->recv; is $payload, $message, "Message received"; kill TERM => $device; waitpid($device,0); }; done_testing; ZMQ-FFI-1.19/t/unicode.t0000644000000000000000000000322214463157020013272 0ustar rootrootuse strict; use warnings; use utf8; use Test::More; use Test::Warnings; use List::Util qw(sum); use lib 't/lib'; use ZMQTest; use ZMQ::FFI qw(ZMQ_PUSH ZMQ_PULL); my $endpoint = ZMQTest->endpoint("test-zmq-ffi-$$"); my $ctx = ZMQ::FFI->new(); my $s1 = $ctx->socket(ZMQ_PUSH); $s1->connect($endpoint); my $s2 = $ctx->socket(ZMQ_PULL); $s2->bind($endpoint); my $pack_template = 'U*'; my $msg = 'werde ich von Dir hören?'; subtest 'send_unicode_bytes' => sub { ok utf8::is_utf8($msg), "created unicode message"; $s1->send($msg); my $recvd = $s2->recv(); { use bytes; is length($recvd), length($msg), "byte length matches"; my @sent_bytes = unpack($pack_template, $msg); my @recvd_bytes = unpack($pack_template, $recvd); is_deeply \@recvd_bytes, \@sent_bytes, "bytes match" ; } }; subtest 'send_multipart_unicode_bytes' => sub { my $multipart = [ ($msg) x 3 ]; my $is_unicode = 1; $is_unicode &&= utf8::is_utf8($_) for (@$multipart); ok $is_unicode, "created unicode message parts"; $s1->send_multipart($multipart); my @recvd = $s2->recv_multipart(); { use bytes; my $sent_len = sum(map { length($_) } @$multipart); my $recvd_len = sum(map { length($_) } @recvd); is $recvd_len, $sent_len, "byte length matches"; my @sent_bytes = map { unpack( $pack_template, $_ ) } @$multipart; my @recvd_bytes = map { unpack( $pack_template, $_ ) } @recvd; is_deeply \@recvd_bytes, \@sent_bytes, "bytes match" ; } }; done_testing(); ZMQ-FFI-1.19/t/unbind.t0000644000000000000000000000164014463157020013125 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use Test::Exception; use lib 't/lib'; use ZMQTest; use ZMQ::FFI qw(ZMQ_REQ ZMQ_REP ZMQ_LAST_ENDPOINT); my $e = ZMQTest->endpoint("test-zmq-ffi-$$"); my $c = ZMQ::FFI->new(); my $s1 = $c->socket(ZMQ_REQ); $s1->connect($e); my $s2 = $c->socket(ZMQ_REP); $s2->bind($e); my ($major) = $c->version(); if ( $major == 2 ) { throws_ok { $s1->disconnect($e) } qr'not available in zmq 2.x', 'threw unimplemented error for 2.x'; throws_ok { $s2->unbind($e) } qr'not available in zmq 2.x', 'threw unimplemented error for 2.x'; } else { lives_ok { $s1->disconnect($e) } 'first disconnect lives'; lives_ok { $s2->unbind($e) } 'first unbind lives'; dies_ok { $s1->disconnect($e) } 'second disconnect dies'; dies_ok { $s2->unbind($e) } 'second unbind dies'; } done_testing; ZMQ-FFI-1.19/t/fork-02.t0000644000000000000000000001157514463157020013036 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use lib 't/lib'; use ZMQTest; use ZMQ::FFI qw(ZMQ_REQ); if( ! ZMQTest->platform_can_fork ) { plan skip_all => 'fork(2) unavailable'; } # # Test that we _do_ clean up contexts/sockets created in forked children # my $parent_c = ZMQ::FFI->new(); my $parent_s = $parent_c->socket(ZMQ_REQ); my $child_pid = open(FROM_CHILDTEST, '-|') // die "fork failed $!"; if ($child_pid) { # parent process, do test assertions here my $result; read(FROM_CHILDTEST, $result, 128); waitpid $child_pid, 0; is $result, 'ok', 'child process did child ctx/socket cleanup'; my $parent_s_closed; my $parent_c_destroyed; my $parent_pid_check = sub { ok $parent_c->_pid == $$, "parent context pid _should_ match parent pid"; ok $parent_s->_pid == $$, "parent socket pid _should_ match parent pid"; # explicitly undef ctx/socket created in parent to trigger DEMOLISH/ # cleanup logic.. then verify that close/destroy _was_ called # for ctx/socket created in parent undef $parent_s; undef $parent_c; ok $parent_s_closed, "parent socket closed in parent"; ok $parent_c_destroyed, "parent context destroyed in parent"; }; my ($major, $minor) = $parent_c->version; if ($major == 2) { no warnings qw/redefine once/; local *ZMQ::FFI::ZMQ2::Socket::zmq_close = sub { $parent_s_closed = 1; }; local *ZMQ::FFI::ZMQ2::Context::zmq_term = sub { $parent_c_destroyed = 1; }; use warnings; $parent_pid_check->(); } elsif ($major == 3) { no warnings qw/redefine once/; local *ZMQ::FFI::ZMQ3::Socket::zmq_close = sub { $parent_s_closed = 1; }; local *ZMQ::FFI::ZMQ3::Context::zmq_ctx_destroy = sub { $parent_c_destroyed = 1; }; use warnings; $parent_pid_check->(); } else { if ($major == 4 and $minor == 0) { no warnings qw/redefine once/; local *ZMQ::FFI::ZMQ4::Socket::zmq_close = sub { $parent_s_closed = 1; }; local *ZMQ::FFI::ZMQ4::Context::zmq_ctx_term = sub { $parent_c_destroyed = 1; }; use warnings; $parent_pid_check->(); } else { no warnings qw/redefine once/; local *ZMQ::FFI::ZMQ4_1::Socket::zmq_close = sub { $parent_s_closed = 1; }; local *ZMQ::FFI::ZMQ4_1::Context::zmq_ctx_term = sub { $parent_c_destroyed = 1; }; use warnings; $parent_pid_check->(); } } } else { # check test expectataions and print 'ok' if successful my $child_c = ZMQ::FFI->new(); my $child_s = $child_c->socket(ZMQ_REQ); my $child_s_closed; my $child_c_destroyed; my $child_pid_check = sub { if ( $child_c->_pid != $$ ) { print "child context pid _should_ match child pid"; exit; } if ( $child_s->_pid != $$ ) { print "child socket pid _should_ match child pid"; exit; } # explicitly undef ctx/socket created in child to trigger DEMOLISH/ # cleanup logic.. then verify that close/destroy _was_ called # for ctx/socket created in child undef $child_s; undef $child_c; if ( !$child_s_closed ) { print "child socket not closed in child!"; exit; } if ( !$child_c_destroyed) { print "child context not destroyed in child!"; exit; } print 'ok'; }; my ($major, $minor) = $child_c->version; if ($major == 2) { no warnings qw/redefine once/; local *ZMQ::FFI::ZMQ2::Socket::zmq_close = sub { $child_s_closed = 1; }; local *ZMQ::FFI::ZMQ2::Context::zmq_term = sub { $child_c_destroyed = 1; }; use warnings; $child_pid_check->(); } elsif ($major == 3) { no warnings qw/redefine once/; local *ZMQ::FFI::ZMQ3::Socket::zmq_close = sub { $child_s_closed = 1; }; local *ZMQ::FFI::ZMQ3::Context::zmq_ctx_destroy = sub { $child_c_destroyed = 1; }; use warnings; $child_pid_check->(); } else { if ($major == 4 and $minor == 0) { no warnings qw/redefine once/; local *ZMQ::FFI::ZMQ4::Socket::zmq_close = sub { $child_s_closed = 1; }; local *ZMQ::FFI::ZMQ4::Context::zmq_ctx_term = sub { $child_c_destroyed = 1; }; use warnings; $child_pid_check->(); } else { no warnings qw/redefine once/; local *ZMQ::FFI::ZMQ4_1::Socket::zmq_close = sub { $child_s_closed = 1; }; local *ZMQ::FFI::ZMQ4_1::Context::zmq_ctx_term = sub { $child_c_destroyed = 1; }; use warnings; $child_pid_check->(); } } exit; } done_testing; ZMQ-FFI-1.19/t/errors.t0000644000000000000000000000720414463157020013164 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use Test::Exception; use lib 't/lib'; use ZMQTest; use FFI::Platypus; use Errno qw(EINVAL EAGAIN); use ZMQ::FFI qw(:all); use ZMQ::FFI::Util qw(zmq_soname); subtest 'socket errors' => sub { $! = EINVAL; my $einval_str; { # get the EINVAL error string in a locale aware way use locale; use bytes; $einval_str = "$!"; } my $ctx = ZMQ::FFI->new(); throws_ok { $ctx->socket(-1) } qr/$einval_str/i, q(invalid socket type dies with EINVAL); my $socket = $ctx->socket(ZMQ_REQ); throws_ok { $socket->connect('foo') } qr/$einval_str/i, q(invalid endpoint dies with EINVAL); }; subtest 'util errors' => sub { no warnings q/redefine/; local *FFI::Platypus::function = sub { return; }; throws_ok { zmq_soname(die => 1) } qr/Could not load libzmq/, q(zmq_soname dies when die => 1 and FFI::Platypus->function fails); lives_ok { ok !zmq_soname(); } q(zmq_soname lives and returns undef when die => 0) . q( and FFI::Platypus->function fails); }; subtest 'fatal socket error' => sub { no warnings qw/redefine once/; local *ZMQ::FFI::ZMQ2::Socket::zmq_send = sub { return -1; }; local *ZMQ::FFI::ZMQ3::Socket::zmq_send = sub { return -1; }; local *ZMQ::FFI::ZMQ4::Socket::zmq_send = sub { return -1; }; local *ZMQ::FFI::ZMQ4_1::Socket::zmq_send = sub { return -1; }; my $ctx = ZMQ::FFI->new(); my $socket = $ctx->socket(ZMQ_REQ); throws_ok { $socket->send('ohhai'); } qr/^zmq_send:/, q(socket error on send dies with zmq_send error message); }; subtest 'socket recv error && die_on_error => false' => sub { my $ctx = ZMQ::FFI->new(); my $socket = $ctx->socket(ZMQ_REP); $socket->bind(ZMQTest->endpoint("test-zmq-ffi-$$")); check_nonfatal_eagain($socket, 'recv', ZMQ_DONTWAIT); }; subtest 'socket send error && die_on_error => false' => sub { my $ctx = ZMQ::FFI->new(); my $socket = $ctx->socket(ZMQ_DEALER); $socket->bind(ZMQTest->endpoint("test-zmq-ffi-$$")); check_nonfatal_eagain($socket, 'send', 'ohhai', ZMQ_DONTWAIT); }; subtest 'socket recv_multipart error && die_on_error => false' => sub { my $ctx = ZMQ::FFI->new(); my $socket = $ctx->socket(ZMQ_REP); $socket->bind(ZMQTest->endpoint("test-zmq-ffi-$$")); check_nonfatal_eagain($socket, 'recv_multipart', ZMQ_DONTWAIT); }; subtest 'socket send_multipart error && die_on_error => false' => sub { my $ctx = ZMQ::FFI->new(); my $socket = $ctx->socket(ZMQ_DEALER); $socket->bind(ZMQTest->endpoint("test-zmq-ffi-$$")); check_nonfatal_eagain( $socket, 'send_multipart', [qw(foo bar baz)], ZMQ_DONTWAIT ); }; sub check_nonfatal_eagain { my ($socket, $method, @method_args) = @_; $! = EAGAIN; my $eagain_str; { # get the EAGAIN error string in a locale aware way use locale; use bytes; $eagain_str = "$!"; } $socket->die_on_error(0); ok !$socket->has_error, qq(has_error false before $method error); lives_ok { $socket->$method(@method_args); } qq($method error isn't fatal if die_on_error false); ok $socket->has_error, 'has_error true after error'; is $socket->last_errno, EAGAIN, 'last_errno set to error code of last error'; is $socket->last_strerror, $eagain_str, 'last_strerror set to error string of last error'; $socket->die_on_error(1); throws_ok { $socket->$method(@method_args) } qr/$eagain_str/i, qq($method error fatal again after die_on_error set back to true); } done_testing; ZMQ-FFI-1.19/t/closed_socket.t0000644000000000000000000000122114463157020014462 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Deep; use Test::Warnings qw(warnings); use ZMQ::FFI qw(ZMQ_REQ); use ZMQ::FFI::SocketRole; my @socket_methods = @{$Moo::Role::INFO{'ZMQ::FFI::SocketRole'}->{requires}}; my @expected_warnings; push @expected_warnings, re('Operation on closed socket') for (@socket_methods); sub f { my $c = ZMQ::FFI->new(); return $c->socket(ZMQ_REQ); } my @actual_warnings = warnings { my $s = f(); for my $method (@socket_methods) { $s->$method() } }; cmp_deeply( \@actual_warnings, \@expected_warnings, 'got warnings for operations on closed socket' ); done_testing; ZMQ-FFI-1.19/t/fork-01.t0000644000000000000000000000646514463157020013037 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use lib 't/lib'; use ZMQTest; use ZMQ::FFI qw(ZMQ_REQ); if( ! ZMQTest->platform_can_fork ) { plan skip_all => 'fork(2) unavailable'; } # # Test that we guard against trying to clean up context/sockets # created in a parent process in forked children # my $parent_c = ZMQ::FFI->new(); my $parent_s = $parent_c->socket(ZMQ_REQ); my $parent_s_closed; my $parent_c_destroyed; my ($major, $minor) = $parent_c->version; if ($major == 2) { no warnings qw/redefine once/; local *ZMQ::FFI::ZMQ2::Socket::zmq_close = sub { $parent_s_closed = 1; }; local *ZMQ::FFI::ZMQ2::Context::zmq_term = sub { $parent_c_destroyed = 1; }; use warnings; pid_test(); } elsif ($major == 3) { no warnings qw/redefine once/; local *ZMQ::FFI::ZMQ3::Socket::zmq_close = sub { $parent_s_closed = 1; }; local *ZMQ::FFI::ZMQ3::Context::zmq_ctx_destroy = sub { $parent_c_destroyed = 1; }; use warnings; pid_test(); } else { if ($major == 4 and $minor == 0) { no warnings qw/redefine once/; local *ZMQ::FFI::ZMQ4::Socket::zmq_close = sub { $parent_s_closed = 1; }; local *ZMQ::FFI::ZMQ4::Context::zmq_ctx_term = sub { $parent_c_destroyed = 1; }; use warnings; pid_test(); } else { no warnings qw/redefine once/; local *ZMQ::FFI::ZMQ4_1::Socket::zmq_close = sub { $parent_s_closed = 1; }; local *ZMQ::FFI::ZMQ4_1::Context::zmq_ctx_term = sub { $parent_c_destroyed = 1; }; use warnings; pid_test(); } } sub pid_test { my $child_pid = open(FROM_CHILDTEST, '-|') // die "fork failed $!"; if ($child_pid) { # parent process, do test assertions here my $result; read(FROM_CHILDTEST, $result, 128); waitpid $child_pid, 0; is $result, 'ok', 'child process skipped parent ctx/socket cleanup'; ok $parent_c->_pid == $$, "parent context pid _should_ match parent pid"; ok $parent_s->_pid == $$, "parent socket pid _should_ match parent pid"; # explicitly undef ctx/socket created in parent to trigger DEMOLISH/ # cleanup logic.. then verify that close/destroy _was_ called # for ctx/socket created in parent undef $parent_s; undef $parent_c; ok $parent_s_closed, "parent socket closed in parent"; ok $parent_c_destroyed, "parent context destroyed in parent"; } else { # check test expectataions and print 'ok' if successful if ( $parent_c->_pid == $$ ) { print "parent context pid _should not_ match child pid"; exit; } if ( $parent_s->_pid == $$ ) { print "parent socket pid _should not_ match child pid"; exit; } # explicitly undef ctx/socket cloned from parent to trigger DEMOLISH/ # cleanup logic.. then verify that close/destroy _was not_ called # for ctx/socket created in parent undef $parent_s; undef $parent_c; if ( $parent_s_closed ) { print "parent socket closed in child!"; exit; } if ( $parent_c_destroyed) { print "parent context destroyed in child!"; exit; } print 'ok'; exit; } } done_testing; ZMQ-FFI-1.19/t/multipart.t0000644000000000000000000000251714463157020013673 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use lib 't/lib'; use ZMQTest; use ZMQ::FFI qw(ZMQ_DEALER ZMQ_ROUTER ZMQ_DONTWAIT ZMQ_SNDMORE); use Scalar::Util qw(blessed); use Sub::Override; my $endpoint = ZMQTest->endpoint("test-zmq-ffi-$$"); my $ctx = ZMQ::FFI->new(); my $d = $ctx->socket(ZMQ_DEALER); $d->set_identity('mydealer'); my $r = $ctx->socket(ZMQ_ROUTER); $d->connect($endpoint); $r->bind($endpoint); subtest 'multipart send/recv', sub { $d->send_multipart([qw(ABC DEF GHI)]); my @recvd = $r->recv_multipart; is_deeply \@recvd, [qw(mydealer ABC DEF GHI)], 'got dealer ident and message'; }; subtest 'multipart flags', sub { my $sock_class = blessed($d); my @expected_flags = ( ZMQ_SNDMORE | ZMQ_DONTWAIT, ZMQ_SNDMORE | ZMQ_DONTWAIT, ZMQ_DONTWAIT, ); my @expected_flags_strs = ( 'ZMQ_SNDMORE | ZMQ_DONTWAIT', 'ZMQ_SNDMORE | ZMQ_DONTWAIT', 'ZMQ_DONTWAIT', ); my $verify_flags = sub { my ($self, $msg, $flags) = @_; ok $flags == (shift @expected_flags), q($flags == ).(shift @expected_flags_strs); }; my $ov = Sub::Override->new( "${sock_class}::send", $verify_flags ); $d->send_multipart([qw(ABC DEF GHI)], ZMQ_DONTWAIT); }; done_testing; ZMQ-FFI-1.19/t/curve_keypair.t0000644000000000000000000000436314463157020014523 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use Test::Exception; use lib 't/lib'; use ZMQTest; use ZMQ::FFI; use ZMQ::FFI::Constants qw(ZMQ_REQ ZMQ_REP ZMQ_CURVE_SERVER ZMQ_CURVE_SECRETKEY ZMQ_CURVE_PUBLICKEY ZMQ_CURVE_SERVERKEY); my $c = ZMQ::FFI->new(); my ($major, $minor) = $c->version(); my $e = ZMQTest->endpoint("test-zmq-ffi-$$"); if ($major == 4) { if ($minor >= 1) { if ($c->has_capability("curve")) { my ($srv_public, $srv_secret); lives_ok { ($srv_public, $srv_secret) = $c->curve_keypair() } 'Generated curve keypair'; my $s1 = $c->socket(ZMQ_REP); $s1->set(ZMQ_CURVE_SERVER, 'int', '1'); $s1->set(ZMQ_CURVE_SECRETKEY, 'string', $srv_secret); $s1->bind($e); my ($cli_public, $cli_secret); lives_ok { ($cli_public, $cli_secret) = $c->curve_keypair() } 'Generated curve keypair'; my $s2 = $c->socket(ZMQ_REQ); $s2->set(ZMQ_CURVE_SERVERKEY, 'string', $srv_public); $s2->set(ZMQ_CURVE_PUBLICKEY, 'string', $cli_public); $s2->set(ZMQ_CURVE_SECRETKEY, 'string', $cli_secret); $s2->connect($e); $s2->send("psst"); is $s1->recv(), 'psst', 'received message'; } else { # zmq >= 4.1 - libsodium is not installed, do nothing } } else { # zmq == 4.0 - can't assume libsodium is installed or uninstalled # so we can't run the curve_keypair() method # verify that has capability is not implemented before 4.1 throws_ok { $c->has_capability() } qr'has_capability not available', 'threw unimplemented error for < 4.1'; } } else { # zmq < 4.x - curve keypair and has capability are not implemented throws_ok { $c->curve_keypair() } qr'curve_keypair not available', 'threw unimplemented error for < 4.x'; throws_ok { $c->has_capability() } qr'has_capability not available', 'threw unimplemented error for < 4.1'; } done_testing; ZMQ-FFI-1.19/t/monitor.t0000644000000000000000000001126114463157020013335 0ustar rootrootuse strict; use warnings; use v5.10; use Test::More; use Test::Warnings; use lib 't/lib'; use ZMQTest; if( ZMQTest->platform_can_sigaction ) { require Sys::SigAction; Sys::SigAction->import(qw(timeout_call)); } else { plan skip_all => 'No Sys::SigAction'; } use ZMQ::FFI qw( ZMQ_DEALER ZMQ_PAIR ZMQ_EVENT_ALL ZMQ_EVENT_CONNECTED ZMQ_EVENT_CONNECT_DELAYED ZMQ_EVENT_CONNECT_RETRIED ZMQ_EVENT_LISTENING ZMQ_EVENT_BIND_FAILED ZMQ_EVENT_ACCEPTED ZMQ_EVENT_ACCEPT_FAILED ZMQ_EVENT_CLOSED ZMQ_EVENT_CLOSE_FAILED ZMQ_EVENT_DISCONNECTED ZMQ_EVENT_MONITOR_STOPPED ZMQ_EVENT_HANDSHAKE_SUCCEEDED ); sub dump_event { my ($socket) = @_; my ($major, $minor, $patch) = $socket->version; say "----------------------------------------"; for my $message ($socket->recv_multipart()) { my $msg_len = length($message); my $is_text = 1; CHECK_TEXT: for (my $i = 0; $i < $msg_len; $i++) { my $c = ord(substr($message, $i, 1)); if ($c < 32 || $c > 126) { $is_text = 0; last CHECK_TEXT; } } printf "[%03d] ", $msg_len; if ($is_text) { say $message; } else { if ($major == 3) { say unpack('H*', $message); my ($event, $ptr, $fd) = unpack('i x4 p i x4', $message); say "$event / $ptr / $fd"; } else { my ($event, $data) = unpack('S L', $message); say "$event / $data"; } } } } subtest 'monitor', sub { my $timed_out = timeout_call(5, sub { my $ctx = ZMQ::FFI->new(); my ($major, $minor, $patch) = $ctx->version(); if ($major < 3) { pass('ZMQ2 does not support zmq_socket_monitor'); return; } my $s = $ctx->socket(ZMQ_DEALER); my $c = $ctx->socket(ZMQ_DEALER); $s->monitor('inproc://monitor-server', ZMQ_EVENT_ALL); $c->monitor('inproc://monitor-client', ZMQ_EVENT_ALL); my $ms = $ctx->socket(ZMQ_PAIR); my $mc = $ctx->socket(ZMQ_PAIR); my $ts = $ctx->socket(ZMQ_PAIR); $ms->connect('inproc://monitor-server'); $mc->connect('inproc://monitor-client'); my $endpoint = ZMQTest->endpoint("test-zmq-ffi-$$"); $s->bind($endpoint); my ($id, $value, $data) = $ms->recv_event(); cmp_ok $id, '==', ZMQ_EVENT_LISTENING, 'Received ZMQ_EVENT_LISTENING event from server socket'; cmp_ok $data, 'eq', $endpoint, "Received endpoint is $endpoint"; $c->connect($endpoint); ($id, $value, $data) = $ms->recv_event(); cmp_ok $id, '==', ZMQ_EVENT_ACCEPTED, 'Received ZMQ_EVENT_ACCEPTED event from server socket'; cmp_ok $data, 'eq', $endpoint, "Received endpoint is $endpoint"; ($id, $value, $data) = $mc->recv_event(); cmp_ok $id, '==', ZMQ_EVENT_CONNECTED, 'Received ZMQ_EVENT_CONNECTED event from client socket'; cmp_ok $data, 'eq', $endpoint, "Received endpoint is $endpoint"; $s->close(); # WARNING: # ZMQ_EVENT_HANDSHAKE_SUCCEEDED event is happend from ZMQ 4.3.2 # with unknown reason and this situation seems like a bug so we need # to change below test code after fixing this bug. if ($major >= 4 && $minor >= 3 && $patch >= 2) { ($id, $value, $data) = $ms->recv_event(); cmp_ok $id, '==', ZMQ_EVENT_HANDSHAKE_SUCCEEDED 'Received ZMQ_EVENT_HANDSHAKE_SUCCEEDED event from server socket'; cmp_ok $data, 'eq', $endpoint, "Received endpoint is $endpoint"; ($id, $value, $data) = $mc->recv_event(); cmp_ok $id, '==', ZMQ_EVENT_HANDSHAKE_SUCCEEDED 'Received ZMQ_EVENT_HANDSHAKE_SUCCEEDED event from client socket'; cmp_ok $data, 'eq', $endpoint, "Received endpoint is $endpoint"; } ($id, $value, $data) = $ms->recv_event(); cmp_ok $id, '==', ZMQ_EVENT_CLOSED, 'Received ZMQ_EVENT_CLOSED event from server socket'; cmp_ok $data, 'eq', $endpoint, "Received endpoint is $endpoint"; ($id, $value, $data) = $mc->recv_event(); cmp_ok $id, '==', ZMQ_EVENT_DISCONNECTED, 'Received ZMQ_EVENT_DISCONNECTED event from client socket'; cmp_ok $data, 'eq', $endpoint, "Received endpoint is $endpoint"; }); ok !$timed_out, 'implicit Socket close done correctly (ctx destruction does not hang)'; }; done_testing; ZMQ-FFI-1.19/t/threads.t0000644000000000000000000000270414463157020013302 0ustar rootroot use strict; use warnings; use Test::More; use Time::HiRes qw(usleep); use ZMQ::FFI qw(ZMQ_REQ ZMQ_ROUTER); my $THREAD_COUNT = 10; my $can_use_threads = eval 'use threads; 1'; if (!$can_use_threads) { plan skip_all => 'This Perl not built to support threads'; } else { # three tests per thread plus NoWarnings test plan tests => $THREAD_COUNT * 3 + 1; require Test::NoWarnings; Test::NoWarnings->import(); } sub worker_task { my $id = shift; my $context = ZMQ::FFI->new(); my $worker = $context->socket(ZMQ_REQ); $worker->set_identity("worker-$id"); $worker->connect('tcp://localhost:5671'); $worker->send("ohhai from worker-$id"); my $reply = $worker->recv(); return ($reply, "worker-$id"); } my $context = ZMQ::FFI->new(); my $broker = $context->socket(ZMQ_ROUTER); $broker->bind('tcp://*:5671'); my @thr; for (1..$THREAD_COUNT) { push @thr, threads->create('worker_task', $_); } for (1..$THREAD_COUNT) { my ($identity, undef, $msg) = $broker->recv_multipart(); like $identity, qr/^worker-\d\d?$/, "got child thread identity '$identity'"; is $msg, "ohhai from $identity", "got child thread '$identity' hello message"; $broker->send_multipart([$identity, '', "goodbye $identity"]); } for my $thr (@thr) { my ($reply, $identity) = $thr->join(); is $reply, "goodbye $identity", "'$identity' got parent thread goodbye message"; } ZMQ-FFI-1.19/t/gc.t0000644000000000000000000000524614463157020012245 0ustar rootrootuse Test::More; use Test::Warnings; use strict; use warnings; use ZMQ::FFI; use ZMQ::FFI::ZMQ2::Context; use ZMQ::FFI::ZMQ2::Socket; use ZMQ::FFI::ZMQ3::Context; use ZMQ::FFI::ZMQ3::Socket; use ZMQ::FFI::ZMQ4::Context; use ZMQ::FFI::ZMQ4::Socket; use ZMQ::FFI::ZMQ4_1::Context; use ZMQ::FFI::ZMQ4_1::Socket; use ZMQ::FFI::Constants qw(ZMQ_REQ); use ZMQ::FFI::Util qw(zmq_version); my @gc_stack; my ($major, $minor) = zmq_version; if ($major == 2) { no warnings q/redefine/; local *ZMQ::FFI::ZMQ2::Context::destroy = sub { my ($self) = @_; $self->context_ptr(-1); push @gc_stack, 'destroy' }; local *ZMQ::FFI::ZMQ2::Socket::close = sub { my ($self) = @_; $self->socket_ptr(-1); push @gc_stack, 'close' }; use warnings; mkcontext(); is_deeply \@gc_stack, ['close', 'close', 'close', 'destroy'], q(socket reaped before context); } elsif ($major == 3) { no warnings q/redefine/; local *ZMQ::FFI::ZMQ3::Context::destroy = sub { my ($self) = @_; $self->context_ptr(-1); push @gc_stack, 'destroy' }; local *ZMQ::FFI::ZMQ3::Socket::close = sub { my ($self) = @_; $self->socket_ptr(-1); push @gc_stack, 'close' }; use warnings; mkcontext(); is_deeply \@gc_stack, ['close', 'close', 'close', 'destroy'], q(sockets closed before context destroyed); } else { if ($major == 4 and $minor == 0) { no warnings q/redefine/; local *ZMQ::FFI::ZMQ4::Context::destroy = sub { my ($self) = @_; $self->context_ptr(-1); push @gc_stack, 'destroy' }; local *ZMQ::FFI::ZMQ4::Socket::close = sub { my ($self) = @_; $self->socket_ptr(-1); push @gc_stack, 'close' }; use warnings; mkcontext(); is_deeply \@gc_stack, ['close', 'close', 'close', 'destroy'], q(sockets closed before context destroyed); } else { no warnings q/redefine/; local *ZMQ::FFI::ZMQ4_1::Context::destroy = sub { my ($self) = @_; $self->context_ptr(-1); push @gc_stack, 'destroy' }; local *ZMQ::FFI::ZMQ4_1::Socket::close = sub { my ($self) = @_; $self->socket_ptr(-1); push @gc_stack, 'close' }; use warnings; mkcontext(); is_deeply \@gc_stack, ['close', 'close', 'close', 'destroy'], q(sockets closed before context destroyed); } } sub mkcontext { my $context = ZMQ::FFI->new(); mksockets($context); return; } sub mksockets { my ($context) = @_; my $s1 = $context->socket(ZMQ_REQ); my $s2 = $context->socket(ZMQ_REQ); my $s3 = $context->socket(ZMQ_REQ); return; } done_testing; ZMQ-FFI-1.19/t/options.t0000644000000000000000000000662214463157020013346 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use Math::BigInt; use lib 't/lib'; use ZMQTest; use ZMQ::FFI qw(:all); use ZMQ::FFI::Util qw(zmq_version); subtest 'ctx version', sub { my $ctx = ZMQ::FFI->new(); is_deeply [zmq_version()], [$ctx->version()], 'util version and ctx version match'; }; subtest 'ctx options', sub { plan skip_all => "libzmq 2.x found, don't test 3.x style ctx options" if (zmq_version())[0] == 2; my $ctx = ZMQ::FFI->new( threads => 42, max_sockets => 42 ); is $ctx->get(ZMQ_IO_THREADS), 42, 'threads set to 42'; is $ctx->get(ZMQ_MAX_SOCKETS), 42, 'max sockets set to 42'; $ctx->set(ZMQ_IO_THREADS, 1); $ctx->set(ZMQ_MAX_SOCKETS, 1024); is $ctx->get(ZMQ_IO_THREADS), 1, 'threads set to 1'; is $ctx->get(ZMQ_MAX_SOCKETS), 1024, 'max sockets set to 1024'; }; subtest 'convenience options', sub { my $ctx = ZMQ::FFI->new(); my $s = $ctx->socket(ZMQ_DEALER); is $s->get_linger(), 0, 'got default linger'; $s->set_linger(42); is $s->get_linger(), 42, 'set linger'; is $s->get_identity(), undef, 'got default identity'; $s->set_identity('foo'); is $s->get_identity(), 'foo', 'set identity'; }; subtest 'string options', sub { my ($major) = zmq_version; plan skip_all => "no string options exist for libzmq 2.x" if $major == 2; my $ctx = ZMQ::FFI->new(); my $s = $ctx->socket(ZMQ_DEALER); my $endpoint = ZMQTest->endpoint("test-zmq-ffi-$$"); $s->bind($endpoint); is $s->get(ZMQ_LAST_ENDPOINT, 'string'), $endpoint, 'got last endpoint'; if ($major >= 4) { $s->set(ZMQ_PLAIN_USERNAME, 'string', 'foo'); is $s->get(ZMQ_PLAIN_USERNAME, 'string'), 'foo', 'setting/getting zmq4 string opt works' } }; subtest 'binary options', sub { my $ctx = ZMQ::FFI->new(); my $s = $ctx->socket(ZMQ_DEALER); # 255 characters long my $long_ident = 'ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'; $s->set(ZMQ_IDENTITY, 'binary', $long_ident); is $s->get(ZMQ_IDENTITY, 'binary'), $long_ident, 'set long identity'; }; subtest 'uint64_t options', sub { my $max_uint64 = Math::BigInt->new('18446744073709551615'); my $ctx = ZMQ::FFI->new(); my $s = $ctx->socket(ZMQ_REQ); $s->set(ZMQ_AFFINITY, 'uint64_t', $max_uint64); is $s->get(ZMQ_AFFINITY, 'uint64_t'), $max_uint64->bstr(), 'set/got max unsigned 64 bit int option value'; }; subtest 'int64_t options', sub { # max negative 64bit values don't currently make # sense with any zmq opts, so we'll stick with positive my $max_int64 = Math::BigInt->new('9223372036854775807'); my $ctx = ZMQ::FFI->new(); my ($major) = $ctx->version; # no int64 opts exist in both versions my $opt; if ($major == 2) { $opt = ZMQ_SWAP; } elsif ($major == 3 || $major == 4) { $opt = ZMQ_MAXMSGSIZE; } else { die "Unsupported zmq version $major"; } my $s = $ctx->socket(ZMQ_REQ); $s->set($opt, 'int64_t', $max_int64); is $s->get($opt, 'int64_t'), $max_int64->bstr(), 'set/got max signed 64 bit int option value'; }; done_testing; ZMQ-FFI-1.19/t/pubsub.t0000644000000000000000000000176314463157020013154 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use lib 't/lib'; use ZMQTest; use ZMQ::FFI qw(ZMQ_PUB ZMQ_SUB ZMQ_DONTWAIT); use Time::HiRes q(usleep); subtest 'pubsub', sub { my $endpoint = ZMQTest->endpoint("test-zmq-ffi-$$"); my $ctx = ZMQ::FFI->new(); my $s = $ctx->socket(ZMQ_SUB); my $p = $ctx->socket(ZMQ_PUB); $s->connect($endpoint); $p->bind($endpoint); { $s->subscribe(''); until ($s->has_pollin) { # sleep for a 100ms to compensate for slow subscriber problem usleep 100_000; $p->send('ohhai'); } my $msg = $s->recv(); is $msg, 'ohhai', 'got msg sent to all topics'; $s->unsubscribe(''); } { $s->subscribe('mytopic'); until ($s->has_pollin) { usleep 100_000; $p->send('mytopic ohhai'); } my $msg = $s->recv(); is $msg, 'mytopic ohhai', 'got msg sent to mytopic'; } }; done_testing; ZMQ-FFI-1.19/t/close.t0000644000000000000000000000123014463157020012746 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use lib 't/lib'; use ZMQTest; if( ZMQTest->platform_can_sigaction ) { require Sys::SigAction; Sys::SigAction->import(qw(timeout_call)); } else { plan skip_all => 'No Sys::SigAction'; } use ZMQ::FFI qw(ZMQ_REQ); subtest 'close with unsent messages', sub { my $timed_out = timeout_call(5, sub { my $ctx = ZMQ::FFI->new(); my $s = $ctx->socket(ZMQ_REQ); $s->connect(ZMQTest->endpoint("test-zmq-ffi-$$")); $s->send('ohhai'); }); ok !$timed_out, 'implicit Socket close done correctly (ctx destruction does not hang)'; }; done_testing; ZMQ-FFI-1.19/docker-shell0000755000000000000000000000022314463157020013514 0ustar rootroot#!/bin/bash docker run --rm -i -t \ -e SHELL=/bin/bash \ -v $(pwd):/zmq-ffi \ -w /zmq-ffi \ calid/zmq-ffi-testenv:ubuntu /bin/bash ZMQ-FFI-1.19/LICENSE0000644000000000000000000004364714463157020012240 0ustar rootrootThis software is copyright (c) 2023 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. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2023 by Dylan Cali. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2023 by Dylan Cali. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End ZMQ-FFI-1.19/COPYING0000644000000000000000000004364514463157020012264 0ustar rootrootThis software is copyright (c) 2013 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. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2013 by Dylan Cali. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2013 by Dylan Cali. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End ZMQ-FFI-1.19/xt/0000755000000000000000000000000014463157020011650 5ustar rootrootZMQ-FFI-1.19/xt/gc_global_destruction.pl0000644000000000000000000000223314463157020016541 0ustar rootrootuse strict; use warnings; use ZMQ::FFI qw(ZMQ_REQ); my $context = ZMQ::FFI->new(); my $socket = $context->socket(ZMQ_REQ); sub closure { $socket } # Suprisingly, the above can cause this script to hang. Closing over $socket # may result in $context getting cleaned up before $socket during global # destruction. This is despite the fact that $socket has a reference to # $context, and therefore would be expected to get cleaned up first (and # always does during normal destruction). # # This triggers a hang as zmq contexts block during cleanup until close has # been called on all sockets. So for single threaded applications you _must_ # close all sockets before attempting to destroy the context. # # Remove the closure and global destruction cleanup happens in the expected # order. However the lesson of course is to not assume _any_ particular # cleanup order during GD. The ordering may change with different perl # versions, different arrangements of the code, different directions of the # wind, etc. # # The old adage "all bets are off during global destruction" is still true # and code that assumes a particular cleanup order during GD will fail # eventually. ZMQ-FFI-1.19/xt/test_versions.sh0000755000000000000000000000321014463157020015112 0ustar rootroot#!/bin/bash set -e function zmq_version { echo $(\ PERL5LIB=lib:$PERL5LIB \ perl -M'ZMQ::FFI::Util q(zmq_version)' \ -E 'print join " ",zmq_version'\ ) } # This assumes libzmqs have been installed to # ~/.zmq-ffi/usr//lib/libzmq.so, e.g. # ~/.zmq-ffi/usr/zeromq2-x/lib/libzmq.so. A docker testing environment is # provided that sets this up according, see the BUILD section in the readme function get_ld_dir { libzmq_dir="$HOME/.zmq-ffi/usr/$1/lib" if test -z "$libzmq_dir/libzmq.so"; then echo "No libzmq.so found in $libzmq_dir" >&2 exit 1 fi echo "$libzmq_dir" } function local_test { test_version=$1 if [[ "$test_version" == "libzmq" ]]; then export LD_LIBRARY_PATH="$(get_ld_dir libzmq)" else export LD_LIBRARY_PATH="$(get_ld_dir zeromq$test_version)" fi echo -e "\nTesting zeromq" \ "$(zmq_version | tr ' ' '.')" run_prove # extra test to check that out-of-order cleanup during global destruction # is handled and doesn't cause a program hang PERL5LIB=lib:$PERL5LIB timeout 1 perl xt/gc_global_destruction.pl \ || (\ echo "xt/gc_global_destruction.pl timed out during cleanup" >&2 \ && exit 1 \ ) } function run_prove { prove -lvr t # test with different locale LANG=fr_FR.utf8 prove -lvr t } for v in "2-x" "3-x" "4-x" "4-1" "libzmq" do local_test $v done # extra test to verify sonames arg is honored LD_LIBRARY_PATH="$(get_ld_dir zeromq2-x)" LD_LIBRARY_PATH+=":$(get_ld_dir zeromq3-x)" export LD_LIBRARY_PATH PERL5LIB=lib:$PERL5LIB perl xt/sonames.pl ZMQ-FFI-1.19/xt/sonames.pl0000644000000000000000000000353614463157020013661 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Exception; use ZMQ::FFI::Util qw(zmq_version); use ZMQ::FFI qw(:all); subtest 'util zmq_version different sonames', sub { ok join('.', zmq_version('libzmq.so.1')) =~ m/^2(\.\d+){2}$/, 'libzmq.so.1 soname gives 2.x version'; ok join('.', zmq_version('libzmq.so.3')) =~ m/^[34](\.\d+){2}$/, 'libzmq.so.3 soname gives 3.x/4.x version'; throws_ok { zmq_version('libzmq.so.X') } qr/Could not find zmq_version in 'libzmq\.so\.X'/, 'bad soname throws error'; }; subtest 'parallel version contexts', sub { my $ctx_v2 = ZMQ::FFI->new(soname => 'libzmq.so.1'); my $ctx_v3 = ZMQ::FFI->new(soname => 'libzmq.so.3'); ok join('.', $ctx_v2->version) =~ m/^2(\.\d+){2}$/, 'libzmq.so.1 soname gives 2.x version'; ok join('.', $ctx_v3->version) =~ m/^[34](\.\d+){2}$/, 'libzmq.so.3 soname gives 3.x/4.x version'; throws_ok { ZMQ::FFI->new(soname => 'libzmq.so.X') } qr/Failed to load 'libzmq\.so\.X'/, 'bad soname throws error'; my $v2_endpoint = "ipc:///tmp/zmq-ffi-ctx2-$$"; my $v3_endpoint = "ipc:///tmp/zmq-ffi-ctx3-$$"; my $s_v2_req = $ctx_v2->socket(ZMQ_REQ); $s_v2_req->connect($v2_endpoint); my $s_v3_req = $ctx_v3->socket(ZMQ_REQ); $s_v3_req->connect($v3_endpoint); my $s_v2_rep = $ctx_v2->socket(ZMQ_REP); $s_v2_rep->bind($v2_endpoint); my $s_v3_rep = $ctx_v3->socket(ZMQ_REP); $s_v3_rep->bind($v3_endpoint); $s_v2_req->send(join('.', $ctx_v2->version)); $s_v3_req->send(join('.', $ctx_v3->version)); ok $s_v2_rep->recv() =~ m/^2(\.\d+){2}$/, 'got zmq 2.x message'; ok $s_v3_rep->recv() =~ m/^[34](\.\d+){2}$/, 'got zmq 3.x/4.x message'; }; done_testing; ZMQ-FFI-1.19/MANIFEST0000644000000000000000000000317414463157020012353 0ustar rootroot# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. COPYING Changes Dockerfile LICENSE MANIFEST META.json META.yml Makefile.PL README README.md bench/zmq-bench-subcriber.pl bench/zmq-bench.c bench/zmq-bench.pl dist.ini docker-run docker-shell inc/ContextWrapperRole.pm inc/SocketWrapperRole.pm inc/ZMQ2/ContextWrappers.pm inc/ZMQ2/SocketWrappers.pm inc/ZMQ3/ContextWrappers.pm inc/ZMQ3/SocketWrappers.pm inc/ZMQ4/ContextWrappers.pm inc/ZMQ4/SocketWrappers.pm inc/ZMQ4_1/ContextWrappers.pm inc/ZMQ4_1/SocketWrappers.pm inc/ZmqContext.pm.tt inc/ZmqSocket.pm.tt lib/ZMQ/FFI.pm lib/ZMQ/FFI/Constants.pm lib/ZMQ/FFI/ContextRole.pm lib/ZMQ/FFI/Custom/Raw.pm lib/ZMQ/FFI/ErrorHelper.pm lib/ZMQ/FFI/SocketRole.pm lib/ZMQ/FFI/Util.pm lib/ZMQ/FFI/Versioner.pm lib/ZMQ/FFI/ZMQ2/Context.pm lib/ZMQ/FFI/ZMQ2/Raw.pm lib/ZMQ/FFI/ZMQ2/Socket.pm lib/ZMQ/FFI/ZMQ3/Context.pm lib/ZMQ/FFI/ZMQ3/Raw.pm lib/ZMQ/FFI/ZMQ3/Socket.pm lib/ZMQ/FFI/ZMQ4/Context.pm lib/ZMQ/FFI/ZMQ4/Raw.pm lib/ZMQ/FFI/ZMQ4/Socket.pm lib/ZMQ/FFI/ZMQ4_1/Context.pm lib/ZMQ/FFI/ZMQ4_1/Raw.pm lib/ZMQ/FFI/ZMQ4_1/Socket.pm scripts/Dockerfile.perl-zmq-base scripts/docker-build scripts/docker-push scripts/docker-release-shell scripts/docker-test-install scripts/gen_modules.pl scripts/gen_zmq_constants.pl scripts/print_zmq_msg_size.c t/close.t t/closed_socket.t t/curve_keypair.t t/device.t t/errors.t t/fd.t t/fork-01.t t/fork-02.t t/gc.t t/lib/ZMQTest.pm t/linger.t t/monitor.t t/multipart.t t/options.t t/proxy.t t/pubsub.t t/router-req.t t/send_recv.t t/threads.t t/unbind.t t/unicode.t t/z85_encoding.t weaver.ini xt/gc_global_destruction.pl xt/sonames.pl xt/test_versions.sh ZMQ-FFI-1.19/inc/0000755000000000000000000000000014463157020011766 5ustar rootrootZMQ-FFI-1.19/inc/ZmqSocket.pm.tt0000644000000000000000000000245014463157020014673 0ustar rootroot# # Module Generated by Template::Tiny on [% date %] # package ZMQ::FFI::[% zmqver %]::Socket; use FFI::Platypus; use FFI::Platypus::Buffer; use FFI::Platypus::Memory qw(malloc free memcpy); use Carp qw(croak carp); use Try::Tiny; use ZMQ::FFI::[% zmqver %]::Raw; use ZMQ::FFI::Custom::Raw; use ZMQ::FFI::Constants qw(:all); use ZMQ::FFI::Util qw(current_tid); [% lib_imports %] 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) { ZMQ::FFI::Custom::Raw::load($self->soname); ZMQ::FFI::[% zmqver %]::Raw::load($self->soname); $FFI_LOADED = 1; } # 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); } [% FOREACH method IN api_methods %] [%- [%- method -%] -%] [% END %] sub DEMOLISH { my ($self) = @_; # remove ourselves from the context object so that we dont leak $self->context->_remove_socket($self) if (defined $self->context); return if $self->socket_ptr == -1; $self->close(); } 1; # vim:ft=perl ZMQ-FFI-1.19/inc/ZmqContext.pm.tt0000644000000000000000000000264114463157020015071 0ustar rootroot# # Module Generated by Template::Tiny on [% date %] # package ZMQ::FFI::[% zmqver %]::Context; use FFI::Platypus; use ZMQ::FFI::Util qw(zmq_soname current_tid); use ZMQ::FFI::Constants qw(:all); use ZMQ::FFI::[% zmqver %]::Socket; use ZMQ::FFI::[% zmqver %]::Raw; use ZMQ::FFI::Custom::Raw; use Try::Tiny; use Scalar::Util qw(weaken); [% lib_imports %] use Moo; use namespace::clean; with qw( ZMQ::FFI::ContextRole ZMQ::FFI::ErrorHelper ZMQ::FFI::Versioner ); my $FFI_LOADED; sub BUILD { my ($self) = @_; unless ($FFI_LOADED) { ZMQ::FFI::Custom::Raw::load($self->soname); ZMQ::FFI::[% zmqver %]::Raw::load($self->soname); $FFI_LOADED = 1; } $self->init() } [% FOREACH method IN api_methods %] [%- [%- method -%] -%] [% END %] sub _add_socket { my ($self, $socket) = @_; weaken($self->sockets->{$socket} = $socket); } sub _remove_socket { my ($self, $socket) = @_; delete($self->sockets->{$socket}); } sub DEMOLISH { my ($self) = @_; return if $self->context_ptr == -1; # check defined to guard against # undef objects during global destruction if (defined $self->sockets) { for my $socket_k (keys %{$self->sockets}) { my $socket = $self->_remove_socket($socket_k); $socket->close() if defined $socket && $socket->socket_ptr != -1; } } $self->destroy(); } 1; # vim:ft=perl ZMQ-FFI-1.19/inc/ContextWrapperRole.pm0000644000000000000000000000166414463157020016142 0ustar rootrootpackage inc::ContextWrapperRole; use Moo::Role; use namespace::clean; use Path::Class qw(file); use ZMQ::FFI::ContextRole; my @ctx_methods = @{$Moo::Role::INFO{'ZMQ::FFI::ContextRole'}->{requires}}; requires $_."_tt" for @ctx_methods; has zmqver => ( is => 'ro', required => 1, ); has api_methods => ( is => 'ro', default => sub { \@ctx_methods }, ); has template => ( is => 'ro', default => sub { file('inc/ZmqContext.pm.tt') }, ); has target => ( is => 'lazy', ); has lib_imports => ( is => 'ro', default => '', ); sub _build_target { my ($self) = @_; my $zmqver = $self->zmqver; return file("lib/ZMQ/FFI/$zmqver/Context.pm"), } sub wrappers { my ($self) = @_; my %wrappers; for my $ctx_method (@ctx_methods) { my $template_method = $ctx_method."_tt"; $wrappers{$ctx_method} = $self->$template_method; } return \%wrappers; } 1; ZMQ-FFI-1.19/inc/ZMQ4_1/0000755000000000000000000000000014463157020012741 5ustar rootrootZMQ-FFI-1.19/inc/ZMQ4_1/ContextWrappers.pm0000644000000000000000000000035114463157020016446 0ustar rootrootpackage inc::ZMQ4_1::ContextWrappers; use Moo; use namespace::clean; extends 'inc::ZMQ4::ContextWrappers'; sub has_capability_tt {q( sub has_capability { my ($self, $capability) = @_; return zmq_has($capability); } )} 1; ZMQ-FFI-1.19/inc/ZMQ4_1/SocketWrappers.pm0000644000000000000000000000015714463157020016256 0ustar rootrootpackage inc::ZMQ4_1::SocketWrappers; use Moo; use namespace::clean; extends 'inc::ZMQ4::SocketWrappers'; 1; ZMQ-FFI-1.19/inc/ZMQ4/0000755000000000000000000000000014463157020012521 5ustar rootrootZMQ-FFI-1.19/inc/ZMQ4/ContextWrappers.pm0000644000000000000000000000355314463157020016235 0ustar rootrootpackage inc::ZMQ4::ContextWrappers; use Moo; use namespace::clean; extends 'inc::ZMQ3::ContextWrappers'; has +lib_imports => ( is => 'ro', default => q( use FFI::Platypus::Memory qw(free malloc); use FFI::Platypus::Buffer qw(buffer_to_scalar); ), ); sub destroy_tt {q( sub destroy { my ($self) = @_; return if $self->context_ptr == -1; # don't try to cleanup context cloned from another thread return unless $self->_tid == current_tid(); # don't try to cleanup context copied from another process (fork) return unless $self->_pid == $$; $self->check_error( 'zmq_ctx_term', zmq_ctx_term($self->context_ptr) ); $self->context_ptr(-1); } )} sub curve_keypair_tt {q( sub curve_keypair { my ($self) = @_; my $public_key_buf = malloc(41); my $secret_key_buf = malloc(41); $self->check_error( 'zmq_curve_keypair', zmq_curve_keypair($public_key_buf, $secret_key_buf) ); my $public_key = buffer_to_scalar($public_key_buf, 41); my $secret_key = buffer_to_scalar($secret_key_buf, 41); free($public_key_buf); free($secret_key_buf); return ($public_key, $secret_key); } )} sub z85_encode_tt {q( sub z85_encode { my ($self, $data) = @_; my $dest_buf = malloc(41); my $checked_data = substr($data, 0, 32); $self->check_null( 'zmq_z85_encode', zmq_z85_encode( $dest_buf, $checked_data, length($checked_data) ) ); my $dest = buffer_to_scalar($dest_buf, 41); free($dest_buf); return $dest; } )} sub z85_decode_tt {q( sub z85_decode { my ($self, $string) = @_; my $dest_buf = malloc(32); $self->check_null( 'zmq_z86_decode', zmq_z85_decode($dest_buf, $string) ); my $dest = buffer_to_scalar($dest_buf, 32); free($dest_buf); return $dest; } )} 1; ZMQ-FFI-1.19/inc/ZMQ4/SocketWrappers.pm0000644000000000000000000000055014463157020016033 0ustar rootrootpackage inc::ZMQ4::SocketWrappers; use Moo; use namespace::clean; extends 'inc::ZMQ3::SocketWrappers'; sub recv_event_tt {q( sub recv_event { my ($self, $flags) = @_; [% closed_socket_check %] my ($event, $endpoint) = $self->recv_multipart($flags); my ($id, $value) = unpack('S L', $event); return ($id, $value, $endpoint); } )} 1; ZMQ-FFI-1.19/inc/SocketWrapperRole.pm0000644000000000000000000000170414463157020015741 0ustar rootrootpackage inc::SocketWrapperRole; use Moo::Role; use namespace::clean; use Path::Class qw(file); use ZMQ::FFI::SocketRole; my @socket_methods = @{$Moo::Role::INFO{'ZMQ::FFI::SocketRole'}->{requires}}; requires $_."_tt" for @socket_methods; has zmqver => ( is => 'ro', required => 1, ); has api_methods => ( is => 'ro', default => sub { \@socket_methods }, ); has template => ( is => 'ro', default => sub { file('inc/ZmqSocket.pm.tt') }, ); has target => ( is => 'lazy', ); has lib_imports => ( is => 'ro', default => '', ); sub _build_target { my ($self) = @_; my $zmqver = $self->zmqver; return file("lib/ZMQ/FFI/$zmqver/Socket.pm"), } sub wrappers { my ($self) = @_; my %wrappers; for my $socket_method (@socket_methods) { my $template_method = $socket_method."_tt"; $wrappers{$socket_method} = $self->$template_method; } return \%wrappers; } 1; ZMQ-FFI-1.19/inc/ZMQ3/0000755000000000000000000000000014463157020012520 5ustar rootrootZMQ-FFI-1.19/inc/ZMQ3/ContextWrappers.pm0000644000000000000000000000353214463157020016231 0ustar rootrootpackage inc::ZMQ3::ContextWrappers; use Moo; use namespace::clean; extends 'inc::ZMQ2::ContextWrappers'; sub init_tt {q( sub init { my ($self) = @_; try { $self->context_ptr( zmq_ctx_new() ); $self->check_null('zmq_ctx_new', $self->context_ptr); } catch { $self->context_ptr(-1); die $_; }; if ( $self->has_threads ) { $self->set(ZMQ_IO_THREADS, $self->threads); } if ( $self->has_max_sockets ) { $self->set(ZMQ_MAX_SOCKETS, $self->max_sockets); } } )} sub get_tt {q( sub get { my ($self, $option) = @_; my $option_val = zmq_ctx_get($self->context_ptr, $option); $self->check_error('zmq_ctx_get', $option_val); return $option_val; } )} sub set_tt {q( sub set { my ($self, $option, $option_val) = @_; $self->check_error( 'zmq_ctx_set', zmq_ctx_set($self->context_ptr, $option, $option_val) ); } )} sub proxy_tt {q( sub proxy { my ($self, $frontend, $backend, $capture) = @_; $self->check_error( 'zmq_proxy', zmq_proxy( $frontend->socket_ptr, $backend->socket_ptr, defined $capture ? $capture->socket_ptr : undef, ) ); } )} sub device_tt {q( sub device { my ($self, $type, $frontend, $backend) = @_; $self->bad_version( $self->verstr, "zmq_device not available in zmq >= 3.x", ); } )} sub destroy_tt {q( sub destroy { my ($self) = @_; return if $self->context_ptr == -1; # don't try to cleanup context cloned from another thread return unless $self->_tid == current_tid(); # don't try to cleanup context copied from another process (fork) return unless $self->_pid == $$; $self->check_error( 'zmq_ctx_destroy', zmq_ctx_destroy($self->context_ptr) ); $self->context_ptr(-1); } )} 1; ZMQ-FFI-1.19/inc/ZMQ3/SocketWrappers.pm0000644000000000000000000000516214463157020016036 0ustar rootrootpackage inc::ZMQ3::SocketWrappers; use Moo; use namespace::clean; extends 'inc::ZMQ2::SocketWrappers'; # # for zmq wrappers below that are hot spots (e.g. send/recv) we sacrifice # readability for performance (by for example not assigning method params # to local variables) # sub disconnect_tt {q( sub disconnect { my ($self, $endpoint) = @_; [% closed_socket_check %] unless ($endpoint) { croak 'usage: $socket->disconnect($endpoint)'; } $self->check_error( 'zmq_disconnect', zmq_disconnect($self->socket_ptr, $endpoint) ); } )} sub unbind_tt {q( sub unbind { my ($self, $endpoint) = @_; [% closed_socket_check %] unless ($endpoint) { croak 'usage: $socket->unbind($endpoint)'; } $self->check_error( 'zmq_unbind', zmq_unbind($self->socket_ptr, $endpoint) ); } )} sub send_tt {q( sub send { # 0: self # 1: data # 2: flags [% closed_socket_check %] $_[0]->{last_errno} = 0; use bytes; my $length = length($_[1]); no bytes; if ( -1 == zmq_send($_[0]->socket_ptr, $_[1], $length, ($_[2] // 0)) ) { $_[0]->{last_errno} = zmq_errno(); if ($_[0]->die_on_error) { $_[0]->fatal('zmq_send'); } return; } } )} sub recv_tt {q( sub recv { # 0: self # 1: flags [% closed_socket_check %] $_[0]->{last_errno} = 0; # retval = msg size my $retval = zmq_msg_recv($_[0]->{"_zmq_msg_t"}, $_[0]->socket_ptr, $_[1] // 0); if ( $retval == -1 ) { $_[0]->{last_errno} = zmq_errno(); if ($_[0]->die_on_error) { $_[0]->fatal('zmq_msg_recv'); } return; } if ($retval) { return buffer_to_scalar(zmq_msg_data($_[0]->{"_zmq_msg_t"}), $retval); } return ''; } )} sub monitor_tt {q( sub monitor { my ($self, $endpoint, $event) = @_; [% closed_socket_check %] unless ($endpoint) { croak 'usage: $socket->monitor($endpoint, $events)'; } $self->check_error( 'zmq_socket_monitor', zmq_socket_monitor($self->socket_ptr, $endpoint, $event) ); } )} sub recv_event_tt {q( sub recv_event { my ($self, $flags) = @_; [% closed_socket_check %] my $msg = $self->recv($flags); my $len = length($msg); my ($id, $data, $value); if ($len == $self->event_size) { ($id, $data, $value) = unpack('i p i', $msg); } elsif ($len > $self->event_size) { my $padding = ($len - $self->event_size) / 2; ($id, $data, $value) = unpack("i x$padding p i x$padding", $msg); } return ($id, $value, $data); } )} 1; ZMQ-FFI-1.19/inc/ZMQ2/0000755000000000000000000000000014463157020012517 5ustar rootrootZMQ-FFI-1.19/inc/ZMQ2/ContextWrappers.pm0000644000000000000000000000633714463157020016236 0ustar rootrootpackage inc::ZMQ2::ContextWrappers; use Moo; use namespace::clean; with 'inc::ContextWrapperRole'; sub init_tt {q( has '+threads' => ( default => 1, ); sub init { my ($self) = @_; if ($self->has_max_sockets) { $self->bad_version( $self->verstr, 'max_sockets option not available in zmq 2.x', 'use_die', ) } try { $self->context_ptr( zmq_init($self->threads) ); $self->check_null('zmq_init', $self->context_ptr); } catch { $self->context_ptr(-1); die $_; }; } )} sub get_tt {q( sub get { my ($self) = @_; $self->bad_version( $self->verstr, "getting ctx options not available in zmq 2.x" ); } )} sub set_tt {q( sub set { my ($self) = @_; $self->bad_version( $self->verstr, "setting ctx options not available in zmq 2.x" ); } )} sub socket_tt {q( sub socket { my ($self, $type) = @_; my $socket; try { my $socket_ptr = zmq_socket($self->context_ptr, $type); $self->check_null('zmq_socket', $socket_ptr); $socket = ZMQ::FFI::[% zmqver %]::Socket->new( socket_ptr => $socket_ptr, context => $self, # this will become a weak ref type => $type, soname => $self->soname, ); } catch { die $_; }; # add the socket to the socket hash $self->_add_socket($socket); return $socket; } )} # zeromq v2 does not provide zmq_proxy # implemented here in terms of zmq_device sub proxy_tt {q( sub proxy { my ($self, $frontend, $backend, $capture) = @_; if ($capture){ $self->bad_version( $self->verstr, "capture socket not supported in zmq 2.x" ); } $self->check_error( 'zmq_device', zmq_device(ZMQ_STREAMER, $frontend->socket_ptr, $backend->socket_ptr) ); } )} sub device_tt {q( sub device { my ($self, $type, $frontend, $backend) = @_; $self->check_error( 'zmq_device', zmq_device($type, $frontend->socket_ptr, $backend->socket_ptr) ); } )} sub destroy_tt {q( sub destroy { my ($self) = @_; return if $self->context_ptr == -1; # don't try to cleanup context cloned from another thread return unless $self->_tid == current_tid(); # don't try to cleanup context copied from another process (fork) return unless $self->_pid == $$; $self->check_error( 'zmq_term', zmq_term($self->context_ptr) ); $self->context_ptr(-1); } )} sub curve_keypair_tt {q( sub curve_keypair { my ($self) = @_; $self->bad_version( $self->verstr, "curve_keypair not available in < zmq 4.x" ); } )} sub z85_encode_tt {q( sub z85_encode { my ($self) = @_; $self->bad_version( $self->verstr, "z85_encode not available in < zmq 4.x" ); } )} sub z85_decode_tt {q( sub z85_decode { my ($self) = @_; $self->bad_version( $self->verstr, "z85_decode not available in < zmq 4.x" ); } )} sub has_capability_tt {q( sub has_capability { my ($self) = @_; $self->bad_version( $self->verstr, "has_capability not available in < zmq 4.1" ); } )} 1; ZMQ-FFI-1.19/inc/ZMQ2/SocketWrappers.pm0000644000000000000000000002425514463157020016041 0ustar rootrootpackage inc::ZMQ2::SocketWrappers; use Moo; use namespace::clean; with 'inc::SocketWrapperRole'; # # for zmq wrappers below that are hot spots (e.g. send/recv) we sacrifice # readability for performance (by for example not assigning method params # to local variables) # sub connect_tt {q( sub connect { my ($self, $endpoint) = @_; [% closed_socket_check %] unless ($endpoint) { croak 'usage: $socket->connect($endpoint)'; } $self->check_error( 'zmq_connect', zmq_connect($self->socket_ptr, $endpoint) ); } )} sub disconnect_tt {q( sub disconnect { my ($self) = @_; [% closed_socket_check %] $self->bad_version( $self->verstr, "disconnect not available in zmq 2.x" ); } )} sub bind_tt {q( sub bind { my ($self, $endpoint) = @_; [% closed_socket_check %] unless ($endpoint) { croak 'usage: $socket->bind($endpoint)' } $self->check_error( 'zmq_bind', zmq_bind($self->socket_ptr, $endpoint) ); } )} sub unbind_tt {q( sub unbind { my ($self) = @_; [% closed_socket_check %] $self->bad_version( $self->verstr, "unbind not available in zmq 2.x" ); } )} sub send_tt {q( sub send { # 0: self # 1: data # 2: flags [% closed_socket_check %] 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_ptr, $_[0]->{"_zmq_msg_t"}, $_[2] // 0) ) { $_[0]->{last_errno} = zmq_errno(); if ($_[0]->die_on_error) { $_[0]->fatal('zmq_send'); } return; } } )} sub send_multipart_tt {q( sub send_multipart { # 0: self # 1: partsref # 2: flags [% closed_socket_check %] 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_tt {q( sub recv { # 0: self # 1: flags [% closed_socket_check %] $_[0]->{last_errno} = 0; if ( -1 == zmq_recv($_[0]->socket_ptr, $_[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 recv_multipart_tt {q( sub recv_multipart { # 0: self # 1: flags [% closed_socket_check %] 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_tt {q( sub get_fd { [% closed_socket_check %] return $_[0]->get(ZMQ_FD, 'int'); } )} sub get_linger_tt {q( sub get_linger { [% closed_socket_check %] return $_[0]->get(ZMQ_LINGER, 'int'); } )} sub set_linger_tt {q( sub set_linger { my ($self, $linger) = @_; [% closed_socket_check %] $self->set(ZMQ_LINGER, 'int', $linger); } )} sub get_identity_tt {q( sub get_identity { [% closed_socket_check %] return $_[0]->get(ZMQ_IDENTITY, 'binary'); } )} sub set_identity_tt {q( sub set_identity { my ($self, $id) = @_; [% closed_socket_check %] $self->set(ZMQ_IDENTITY, 'binary', $id); } )} sub subscribe_tt {q( sub subscribe { my ($self, $topic) = @_; [% closed_socket_check %] $self->set(ZMQ_SUBSCRIBE, 'binary', $topic); } )} sub unsubscribe_tt {q( sub unsubscribe { my ($self, $topic) = @_; [% closed_socket_check %] $self->set(ZMQ_UNSUBSCRIBE, 'binary', $topic); } )} sub has_pollin_tt {q( sub has_pollin { [% closed_socket_check %] return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLIN; } )} sub has_pollout_tt {q( sub has_pollout { [% closed_socket_check %] return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLOUT; } )} sub get_tt {q( sub get { my ($self, $opt, $opt_type) = @_; [% closed_socket_check %] my $optval; my $optval_len; for ($opt_type) { if ($_ =~ /^(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_ptr, $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); } } elsif ($_ eq 'int') { $optval_len = $self->sockopt_sizes->{'int'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } elsif ($_ eq 'int64_t') { $optval_len = $self->sockopt_sizes->{'sint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } elsif ($_ eq 'uint64_t') { $optval_len = $self->sockopt_sizes->{'uint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_uint64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } else { croak "unknown type $opt_type"; } } if ($optval ne '') { return $optval; } return; } )} sub set_tt {q( sub set { my ($self, $opt, $opt_type, $optval) = @_; [% closed_socket_check %] for ($opt_type) { if ($_ =~ /^(binary|string)$/) { my ($optval_ptr, $optval_len) = scalar_to_buffer($optval); $self->check_error( 'zmq_setsockopt', zmq_setsockopt_binary( $self->socket_ptr, $opt, $optval_ptr, $optval_len ) ); } elsif ($_ eq 'int') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'int'} ) ); } elsif ($_ eq 'int64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'sint64'} ) ); } elsif ($_ eq 'uint64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_uint64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'uint64'} ) ); } else { croak "unknown type $opt_type"; } } return; } )} sub close_tt {q( sub close { my ($self) = @_; [% closed_socket_check %] # don't try to cleanup socket cloned from another thread return unless $self->_tid == current_tid(); # don't try to cleanup socket copied from another process (fork) return unless $self->_pid == $$; $self->check_error( 'zmq_msg_close', zmq_msg_close($self->_zmq_msg_t) ); $self->check_error( 'zmq_close', zmq_close($self->socket_ptr) ); $self->socket_ptr(-1); } )} sub monitor_tt {q( sub monitor { my ($self) = @_; [% closed_socket_check %] $self->bad_version( $self->verstr, "monitor not available in zmq 2.x" ); } )} sub recv_event_tt {q( sub recv_event { my ($self) = @_; [% closed_socket_check %] $self->bad_version( $self->verstr, "recv_event not available in zmq 2.x" ); } )} 1;