ZMQ-FFI-1.17/0000755000000000000000000000000013442351400011205 5ustar rootrootZMQ-FFI-1.17/scripts/0000755000000000000000000000000013442351400012674 5ustar rootrootZMQ-FFI-1.17/scripts/docker-release-shell0000755000000000000000000000050313442351400016612 0ustar rootroot#!/bin/bash docker run --rm -i -t \ -e SHELL=/bin/bash \ -v $(pwd):/zmq-ffi \ -v /home/calid/.ssh:/root/.ssh \ -v /home/calid/.pause:/root/.pause \ -v /home/calid/.gitconfig:/root/.gitconfig \ -v /home/calid/.gitignore:/root/.gitignore \ -w /zmq-ffi \ calid/zmq-ffi-testenv:ubuntu /bin/bash ZMQ-FFI-1.17/scripts/gen_modules.pl0000644000000000000000000000314113442351400015531 0ustar rootroot#!/usr/bin/env perl use strict; use warnings; use v5.10; 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.17/scripts/gen_zmq_constants.pl0000644000000000000000000000731613442351400016774 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/ } grep { /\b(ZMQ_[^ ]+\s+(0x)?\d+)/; $_ = $1; } qx(git show $version:include/zmq.h); 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.17/scripts/print_zmq_msg_size.c0000644000000000000000000000014013442351400016756 0ustar rootroot#include #include int main(void) { printf("%zu\n", sizeof(zmq_msg_t)); } ZMQ-FFI-1.17/scripts/Dockerfile.perl-zmq-base0000644000000000000000000000041413442351400017343 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.17/scripts/docker-push0000755000000000000000000000034013442351400015043 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.17/scripts/docker-build0000755000000000000000000000062413442351400015170 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.17/scripts/docker-test-install0000755000000000000000000000041213442351400016507 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.17/LICENSE0000644000000000000000000004364713442351400012230 0ustar rootrootThis software is copyright (c) 2019 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) 2019 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) 2019 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.17/Dockerfile0000644000000000000000000000710013442351400013175 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 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.17/weaver.ini0000644000000000000000000000005613442351400013200 0ustar rootroot[@Default] [-Transformer] transformer = List ZMQ-FFI-1.17/MANIFEST0000644000000000000000000000311613442351400012337 0ustar rootroot# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.010. 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/linger.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 weaver.ini xt/gc_global_destruction.pl xt/sonames.pl xt/test_versions.sh ZMQ-FFI-1.17/README0000644000000000000000000000057413442351400012073 0ustar rootroot This archive contains the distribution ZMQ-FFI, version 1.17: version agnostic Perl bindings for zeromq using ffi This software is copyright (c) 2019 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.010. ZMQ-FFI-1.17/t/0000755000000000000000000000000013442351400011450 5ustar rootrootZMQ-FFI-1.17/t/pubsub.t0000644000000000000000000000171513442351400013141 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use ZMQ::FFI qw(ZMQ_PUB ZMQ_SUB ZMQ_DONTWAIT); use Time::HiRes q(usleep); subtest 'pubsub', sub { my $endpoint = "ipc:///tmp/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.17/t/device.t0000644000000000000000000000320313442351400013072 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use Test::Exception; 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"; my $server_address = "ipc:///tmp/test-zmq-ffi-$$-front"; my $worker_address = "ipc:///tmp/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.17/t/unbind.t0000644000000000000000000000157213442351400013121 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use Test::Exception; use ZMQ::FFI qw(ZMQ_REQ ZMQ_REP ZMQ_LAST_ENDPOINT); my $e = "ipc:///tmp/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.17/t/unicode.t0000644000000000000000000000315413442351400013266 0ustar rootrootuse strict; use warnings; use utf8; use Test::More; use Test::Warnings; use List::Util qw(sum); use ZMQ::FFI qw(ZMQ_PUSH ZMQ_PULL); my $endpoint = "ipc:///tmp/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.17/t/proxy.t0000644000000000000000000000227213442351400013021 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use ZMQ::FFI qw(ZMQ_PUSH ZMQ_PULL); use Time::HiRes q(usleep); use POSIX ":sys_wait_h"; my $server_address = "ipc:///tmp/test-zmq-ffi-$$-front"; my $worker_address = "ipc:///tmp/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.17/t/closed_socket.t0000644000000000000000000000122113442351400014452 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.17/t/curve_keypair.t0000644000000000000000000000431513442351400014510 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(); my $e = "ipc:///tmp/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.17/t/gc.t0000644000000000000000000000524613442351400012235 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.17/t/close.t0000644000000000000000000000075613442351400012752 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use Sys::SigAction qw(timeout_call); 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("ipc:///tmp/test-zmq-ffi-$$"); $s->send('ohhai'); }; ok !$timed_out, 'implicit Socket close done correctly (ctx destruction does not hang)'; }; done_testing; ZMQ-FFI-1.17/t/multipart.t0000644000000000000000000000245113442351400013660 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use ZMQ::FFI qw(ZMQ_DEALER ZMQ_ROUTER ZMQ_DONTWAIT ZMQ_SNDMORE); use Scalar::Util qw(blessed); use Sub::Override; my $endpoint = "ipc:///tmp/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.17/t/router-req.t0000644000000000000000000000202413442351400013740 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use ZMQ::FFI qw(ZMQ_ROUTER ZMQ_REQ); use Time::HiRes q(usleep); subtest 'router-req', sub { my $endpoint = "ipc:///tmp/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.17/t/options.t0000644000000000000000000000655413442351400013342 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use Math::BigInt; 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 = "ipc:///tmp/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.17/t/fork-02.t0000644000000000000000000001141313442351400013015 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use ZMQ::FFI qw(ZMQ_REQ); # # 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.17/t/threads.t0000644000000000000000000000270413442351400013272 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.17/t/linger.t0000644000000000000000000000142513442351400013117 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.17/t/fd.t0000644000000000000000000000146313442351400012232 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use AnyEvent; use ZMQ::FFI qw(ZMQ_PUSH ZMQ_PULL); my $endpoint = "ipc:///tmp/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.17/t/fork-01.t0000644000000000000000000000630313442351400013016 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use ZMQ::FFI qw(ZMQ_REQ); # # 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.17/t/errors.t0000644000000000000000000000710613442351400013155 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use Test::Exception; 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("ipc:///tmp/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("ipc:///tmp/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("ipc:///tmp/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("ipc:///tmp/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.17/t/send_recv.t0000644000000000000000000000122213442351400013602 0ustar rootrootuse strict; use warnings; use Test::More; use Test::Warnings; use ZMQ::FFI qw(ZMQ_REQ ZMQ_REP); my $endpoint = "ipc:///tmp/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.17/Makefile.PL0000644000000000000000000000615713442351400013170 0ustar rootroot# This Makefile.PL for ZMQ-FFI was generated by # Dist::Zilla::Plugin::MakeMaker::Awesome 0.47. # 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.03 use FFI::CheckLib; check_lib_or_exit( 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.11", "FFI::Platypus" => "0.86" }, "DISTNAME" => "ZMQ-FFI", "LICENSE" => "perl", "NAME" => "ZMQ::FFI", "PREREQ_PM" => { "Carp" => 0, "Class::XSAccessor" => "1.18", "Exporter" => 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, "Sys::SigAction" => 0, "Test::Deep" => 0, "Test::Exception" => 0, "Test::More" => 0, "Test::NoWarnings" => 0, "Test::Warnings" => 0, "Time::HiRes" => 0, "locale" => 0, "utf8" => 0 }, "VERSION" => "1.17", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "AnyEvent" => 0, "Carp" => 0, "Class::XSAccessor" => "1.18", "Exporter" => 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, "Sys::SigAction" => 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, "locale" => 0, "namespace::clean" => 0, "strict" => 0, "threads" => 0, "utf8" => 0, "warnings" => 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); ZMQ-FFI-1.17/docker-shell0000755000000000000000000000022313442351400013504 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.17/bench/0000755000000000000000000000000013442351400012264 5ustar rootrootZMQ-FFI-1.17/bench/zmq-bench.pl0000644000000000000000000000334713442351400014514 0ustar rootrootuse strict; use warnings; use v5.10; 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.17/bench/zmq-bench.c0000644000000000000000000000122113442351400014310 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.17/bench/zmq-bench-subcriber.pl0000644000000000000000000000125513442351400016466 0ustar rootrootuse v5.10; use strict; 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.17/COPYING0000644000000000000000000004364513442351400012254 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.17/dist.ini0000644000000000000000000000337213442351400012656 0ustar rootrootname = ZMQ-FFI author = Dylan Cali license = Perl_5 copyright_holder = Dylan Cali [@Filter] -bundle = @Basic -remove = MakeMaker [FFI::CheckLib] lib = zmq [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] [Prereqs / ConfigureRequires] FFI::Platypus = 0.86 [Prereqs / RuntimeRequires] perl = 5.010 Moo = 1.004005 Class::XSAccessor = 1.18 Math::BigInt = 1.997 FFI::Platypus = 0.86 Import::Into = 1.002005 [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 = zmq-ffi [MetaJSON] [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.17/META.yml0000644000000000000000000000243113442351400012456 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' Sys::SigAction: '0' Test::Deep: '0' Test::Exception: '0' Test::More: '0' Test::NoWarnings: '0' Test::Warnings: '0' Time::HiRes: '0' locale: '0' utf8: '0' configure_requires: ExtUtils::MakeMaker: '0' FFI::CheckLib: '0.11' FFI::Platypus: '0.86' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.010, 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 requires: Carp: '0' Class::XSAccessor: '1.18' Exporter: '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: '5.010' strict: '0' threads: '0' warnings: '0' resources: bugtracker: https://github.com/calid/zmq-ffi/issues repository: git://github.com/calid/zmq-ffi.git version: '1.17' x_serialization_backend: 'YAML::Tiny version 1.70' ZMQ-FFI-1.17/inc/0000755000000000000000000000000013442351400011756 5ustar rootrootZMQ-FFI-1.17/inc/ZmqContext.pm.tt0000644000000000000000000000264113442351400015061 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.17/inc/ContextWrapperRole.pm0000644000000000000000000000166413442351400016132 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.17/inc/ZmqSocket.pm.tt0000644000000000000000000000245013442351400014663 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.17/inc/SocketWrapperRole.pm0000644000000000000000000000170413442351400015731 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.17/inc/ZMQ4_1/0000755000000000000000000000000013442351400012731 5ustar rootrootZMQ-FFI-1.17/inc/ZMQ4_1/ContextWrappers.pm0000644000000000000000000000035113442351400016436 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.17/inc/ZMQ4_1/SocketWrappers.pm0000644000000000000000000000015713442351400016246 0ustar rootrootpackage inc::ZMQ4_1::SocketWrappers; use Moo; use namespace::clean; extends 'inc::ZMQ4::SocketWrappers'; 1; ZMQ-FFI-1.17/inc/ZMQ3/0000755000000000000000000000000013442351400012510 5ustar rootrootZMQ-FFI-1.17/inc/ZMQ3/ContextWrappers.pm0000644000000000000000000000353213442351400016221 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.17/inc/ZMQ3/SocketWrappers.pm0000644000000000000000000000346013442351400016025 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 ''; } )} 1; ZMQ-FFI-1.17/inc/ZMQ4/0000755000000000000000000000000013442351400012511 5ustar rootrootZMQ-FFI-1.17/inc/ZMQ4/ContextWrappers.pm0000644000000000000000000000225313442351400016221 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); } )} 1; ZMQ-FFI-1.17/inc/ZMQ4/SocketWrappers.pm0000644000000000000000000000015513442351400016024 0ustar rootrootpackage inc::ZMQ4::SocketWrappers; use Moo; use namespace::clean; extends 'inc::ZMQ3::SocketWrappers'; 1; ZMQ-FFI-1.17/inc/ZMQ2/0000755000000000000000000000000013442351400012507 5ustar rootrootZMQ-FFI-1.17/inc/ZMQ2/ContextWrappers.pm0000644000000000000000000000562113442351400016221 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 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.17/inc/ZMQ2/SocketWrappers.pm0000644000000000000000000002337613442351400016034 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) { when (/^(binary|string)$/) { # ZMQ_IDENTITY uses binary type and can be at most 255 bytes long # # ZMQ_LAST_ENDPOINT uses string type and expects a buffer large # enough to hold an endpoint string # # So for these cases 256 should be sufficient (including \0). # Other binary/string opts are being added all the time, and # hopefully this value scales, but we can always increase it if # necessary my $optval_ptr = malloc(256); $optval_len = 256; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_binary( $self->socket_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); } } when ('int') { $optval_len = $self->sockopt_sizes->{'int'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } when ('int64_t') { $optval_len = $self->sockopt_sizes->{'sint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } when ('uint64_t') { $optval_len = $self->sockopt_sizes->{'uint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_uint64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } default { 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) { when (/^(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 ) ); } when ('int') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'int'} ) ); } when ('int64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'sint64'} ) ); } when ('uint64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_uint64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'uint64'} ) ); } default { 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); } )} 1; ZMQ-FFI-1.17/README.md0000644000000000000000000000734513442351400012475 0ustar rootroot# ZMQ::FFI [![Build Status](https://travis-ci.org/calid/zmq-ffi.svg?branch=master)](https://travis-ci.org/calid/zmq-ffi) ## 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 v5.10; 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 v5.10; 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 v5.10; 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 v5.10; 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.17/xt/0000755000000000000000000000000013442351400011640 5ustar rootrootZMQ-FFI-1.17/xt/sonames.pl0000644000000000000000000000353613442351400013651 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.17/xt/test_versions.sh0000755000000000000000000000321013442351400015102 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.17/xt/gc_global_destruction.pl0000644000000000000000000000223313442351400016531 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.17/Changes0000644000000000000000000001553313442351400012507 0ustar rootroot 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.17/docker-run0000755000000000000000000000015713442351400013207 0ustar rootroot#!/bin/bash docker run --rm \ -v $(pwd):/zmq-ffi \ -w /zmq-ffi \ calid/zmq-ffi-testenv:ubuntu "$@" ZMQ-FFI-1.17/META.json0000644000000000000000000000461113442351400012630 0ustar rootroot{ "abstract" : "version agnostic Perl bindings for zeromq using ffi", "author" : [ "Dylan Cali " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.010, 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", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "FFI::CheckLib" : "0.11", "FFI::Platypus" : "0.86" } }, "develop" : { "requires" : { "Test::Exception" : "0", "Test::More" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Class::XSAccessor" : "1.18", "Exporter" : "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" : "5.010", "strict" : "0", "threads" : "0", "warnings" : "0" } }, "test" : { "requires" : { "AnyEvent" : "0", "List::Util" : "0", "Math::BigInt" : "1.997", "POSIX" : "0", "Sub::Override" : "0", "Sys::SigAction" : "0", "Test::Deep" : "0", "Test::Exception" : "0", "Test::More" : "0", "Test::NoWarnings" : "0", "Test::Warnings" : "0", "Time::HiRes" : "0", "locale" : "0", "utf8" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/calid/zmq-ffi/issues" }, "repository" : { "type" : "git", "url" : "git://github.com/calid/zmq-ffi.git", "web" : "https://github.com/calid/zmq-ffi" } }, "version" : "1.17", "x_serialization_backend" : "Cpanel::JSON::XS version 3.0239" } ZMQ-FFI-1.17/lib/0000755000000000000000000000000013442351400011753 5ustar rootrootZMQ-FFI-1.17/lib/ZMQ/0000755000000000000000000000000013442351400012422 5ustar rootrootZMQ-FFI-1.17/lib/ZMQ/FFI/0000755000000000000000000000000013442351400013026 5ustar rootrootZMQ-FFI-1.17/lib/ZMQ/FFI/Custom/0000755000000000000000000000000013442351400014300 5ustar rootrootZMQ-FFI-1.17/lib/ZMQ/FFI/Custom/Raw.pm0000644000000000000000000000377413442351400015402 0ustar rootrootpackage ZMQ::FFI::Custom::Raw; $ZMQ::FFI::Custom::Raw::VERSION = '1.17'; 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.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/Constants.pm0000644000000000000000000002610513442351400015344 0ustar rootrootpackage ZMQ::FFI::Constants; $ZMQ::FFI::Constants::VERSION = '1.17'; # ABSTRACT: Generated module of zmq constants. All constants, all versions. # Generated using ZMQ versions v2.1.0-v4.3.1 use strict; use warnings; use Exporter 'import'; our @EXPORT_OK = qw( ZMQ_AFFINITY ZMQ_BACKLOG ZMQ_BINDTODEVICE ZMQ_BLOCKY ZMQ_CLIENT ZMQ_CONFLATE ZMQ_CONNECT_RID ZMQ_CONNECT_ROUTING_ID ZMQ_CONNECT_TIMEOUT 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_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_FAIL_UNROUTABLE ZMQ_FD ZMQ_FORWARDER ZMQ_GATHER ZMQ_GROUP_MAX_LENGTH 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_HWM ZMQ_IDENTITY ZMQ_IDENTITY_FD ZMQ_IMMEDIATE ZMQ_INVERT_MATCHING 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_PAIR ZMQ_PLAIN ZMQ_PLAIN_PASSWORD ZMQ_PLAIN_SERVER ZMQ_PLAIN_USERNAME ZMQ_POLLERR ZMQ_POLLIN ZMQ_POLLITEMS_DFLT ZMQ_POLLOUT ZMQ_POLLPRI ZMQ_PROBE_ROUTER 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_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_PROXY 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_XPUB ZMQ_XPUB_MANUAL 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_CLIENT { 13 } sub ZMQ_CONFLATE { 54 } sub ZMQ_CONNECT_RID { 61 } sub ZMQ_CONNECT_ROUTING_ID { 61 } sub ZMQ_CONNECT_TIMEOUT { 79 } 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_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 { 0 } 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_FAIL_UNROUTABLE { 33 } sub ZMQ_FD { 14 } sub ZMQ_FORWARDER { 2 } sub ZMQ_GATHER { 16 } sub ZMQ_GROUP_MAX_LENGTH { 15 } 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_HWM { 1 } sub ZMQ_IDENTITY { 5 } sub ZMQ_IDENTITY_FD { 67 } sub ZMQ_IMMEDIATE { 39 } sub ZMQ_INVERT_MATCHING { 74 } 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_PAIR { 0 } 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_PROBE_ROUTER { 51 } 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_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_PROXY { 68 } 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_XPUB { 9 } sub ZMQ_XPUB_MANUAL { 71 } 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.17 =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.1. 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) 2019 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.17/lib/ZMQ/FFI/ContextRole.pm0000644000000000000000000000242113442351400015631 0ustar rootrootpackage ZMQ::FFI::ContextRole; $ZMQ::FFI::ContextRole::VERSION = '1.17'; 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 has_capability ); 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ContextRole =head1 VERSION version 1.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/ErrorHelper.pm0000644000000000000000000000374213442351400015623 0ustar rootrootpackage ZMQ::FFI::ErrorHelper; $ZMQ::FFI::ErrorHelper::VERSION = '1.17'; 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.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/Versioner.pm0000644000000000000000000000134613442351400015344 0ustar rootrootpackage ZMQ::FFI::Versioner; $ZMQ::FFI::Versioner::VERSION = '1.17'; 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.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/ZMQ4_1/0000755000000000000000000000000013442351400014001 5ustar rootrootZMQ-FFI-1.17/lib/ZMQ/FFI/ZMQ4_1/Context.pm0000644000000000000000000001102313442351400015760 0ustar rootroot# # Module Generated by Template::Tiny on Thu Mar 14 04:05:17 UTC 2019 # package ZMQ::FFI::ZMQ4_1::Context; $ZMQ::FFI::ZMQ4_1::Context::VERSION = '1.17'; 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 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.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/ZMQ4_1/Socket.pm0000644000000000000000000002742213442351400015576 0ustar rootroot# # Module Generated by Template::Tiny on Thu Mar 14 04:05:17 UTC 2019 # package ZMQ::FFI::ZMQ4_1::Socket; $ZMQ::FFI::ZMQ4_1::Socket::VERSION = '1.17'; 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) { when (/^(binary|string)$/) { # ZMQ_IDENTITY uses binary type and can be at most 255 bytes long # # ZMQ_LAST_ENDPOINT uses string type and expects a buffer large # enough to hold an endpoint string # # So for these cases 256 should be sufficient (including \0). # Other binary/string opts are being added all the time, and # hopefully this value scales, but we can always increase it if # necessary my $optval_ptr = malloc(256); $optval_len = 256; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_binary( $self->socket_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); } } when ('int') { $optval_len = $self->sockopt_sizes->{'int'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } when ('int64_t') { $optval_len = $self->sockopt_sizes->{'sint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } when ('uint64_t') { $optval_len = $self->sockopt_sizes->{'uint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_uint64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } default { 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) { when (/^(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 ) ); } when ('int') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'int'} ) ); } when ('int64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'sint64'} ) ); } when ('uint64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_uint64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'uint64'} ) ); } default { 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 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.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/ZMQ4_1/Raw.pm0000644000000000000000000001050013442351400015064 0ustar rootrootpackage ZMQ::FFI::ZMQ4_1::Raw; $ZMQ::FFI::ZMQ4_1::Raw::VERSION = '1.17'; 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( # int zmq_has (const char *capability); ['zmq_has' => "${target}::zmq_has"] => ['string'] => 'int' ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ4_1::Raw =head1 VERSION version 1.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/ZMQ3/0000755000000000000000000000000013442351400013560 5ustar rootrootZMQ-FFI-1.17/lib/ZMQ/FFI/ZMQ3/Context.pm0000644000000000000000000001026713442351400015550 0ustar rootroot# # Module Generated by Template::Tiny on Thu Mar 14 04:05:17 UTC 2019 # package ZMQ::FFI::ZMQ3::Context; $ZMQ::FFI::ZMQ3::Context::VERSION = '1.17'; 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 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.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/ZMQ3/Socket.pm0000644000000000000000000002741013442351400015352 0ustar rootroot# # Module Generated by Template::Tiny on Thu Mar 14 04:05:17 UTC 2019 # package ZMQ::FFI::ZMQ3::Socket; $ZMQ::FFI::ZMQ3::Socket::VERSION = '1.17'; 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) { when (/^(binary|string)$/) { # ZMQ_IDENTITY uses binary type and can be at most 255 bytes long # # ZMQ_LAST_ENDPOINT uses string type and expects a buffer large # enough to hold an endpoint string # # So for these cases 256 should be sufficient (including \0). # Other binary/string opts are being added all the time, and # hopefully this value scales, but we can always increase it if # necessary my $optval_ptr = malloc(256); $optval_len = 256; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_binary( $self->socket_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); } } when ('int') { $optval_len = $self->sockopt_sizes->{'int'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } when ('int64_t') { $optval_len = $self->sockopt_sizes->{'sint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } when ('uint64_t') { $optval_len = $self->sockopt_sizes->{'uint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_uint64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } default { 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) { when (/^(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 ) ); } when ('int') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'int'} ) ); } when ('int64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'sint64'} ) ); } when ('uint64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_uint64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'uint64'} ) ); } default { 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 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.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/ZMQ3/Raw.pm0000644000000000000000000000772513442351400014662 0ustar rootrootpackage ZMQ::FFI::ZMQ3::Raw; $ZMQ::FFI::ZMQ3::Raw::VERSION = '1.17'; 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' ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ3::Raw =head1 VERSION version 1.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/Util.pm0000644000000000000000000000724613442351400014312 0ustar rootrootpackage ZMQ::FFI::Util; $ZMQ::FFI::Util::VERSION = '1.17'; # ABSTRACT: zmq convenience functions use strict; use warnings; use FFI::Platypus; 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}; # Try to find a soname available on this system # # Linux .so symlink conventions are linker_name => soname => real_name # e.g. libzmq.so => libzmq.so.X => libzmq.so.X.Y.Z # Unfortunately not all distros follow this convention (Ubuntu). So first # we'll try the linker_name, then the sonames. # # If Linux extensions fail also try platform specific # extensions (e.g. OS X) before giving up. my @sonames = qw( libzmq.so libzmq.so.5 libzmq.so.4 libzmq.so.3 libzmq.so.1 libzmq.dylib libzmq.4.dylib libzmq.3.dylib libzmq.1.dylib ); my $soname; FIND_SONAME: for (@sonames) { $soname = $_; unless ( valid_soname($soname) ) { undef $soname; } if ($soname) { last FIND_SONAME; } } if ( !$soname && $die ) { croak qq(Could not load libzmq, tried:\n), join(', ', @sonames),"\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.17 =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 the following sonames (in order): libzmq.so libzmq.so.5 libzmq.so.4 libzmq.so.3 libzmq.so.1 libzmq.dylib libzmq.4.dylib libzmq.3.dylib libzmq.1.dylib 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) 2019 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.17/lib/ZMQ/FFI/ZMQ4/0000755000000000000000000000000013442351400013561 5ustar rootrootZMQ-FFI-1.17/lib/ZMQ/FFI/ZMQ4/Context.pm0000644000000000000000000001110013442351400015534 0ustar rootroot# # Module Generated by Template::Tiny on Thu Mar 14 04:05:17 UTC 2019 # package ZMQ::FFI::ZMQ4::Context; $ZMQ::FFI::ZMQ4::Context::VERSION = '1.17'; 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 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.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/ZMQ4/Socket.pm0000644000000000000000000002741013442351400015353 0ustar rootroot# # Module Generated by Template::Tiny on Thu Mar 14 04:05:17 UTC 2019 # package ZMQ::FFI::ZMQ4::Socket; $ZMQ::FFI::ZMQ4::Socket::VERSION = '1.17'; 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) { when (/^(binary|string)$/) { # ZMQ_IDENTITY uses binary type and can be at most 255 bytes long # # ZMQ_LAST_ENDPOINT uses string type and expects a buffer large # enough to hold an endpoint string # # So for these cases 256 should be sufficient (including \0). # Other binary/string opts are being added all the time, and # hopefully this value scales, but we can always increase it if # necessary my $optval_ptr = malloc(256); $optval_len = 256; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_binary( $self->socket_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); } } when ('int') { $optval_len = $self->sockopt_sizes->{'int'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } when ('int64_t') { $optval_len = $self->sockopt_sizes->{'sint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } when ('uint64_t') { $optval_len = $self->sockopt_sizes->{'uint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_uint64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } default { 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) { when (/^(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 ) ); } when ('int') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'int'} ) ); } when ('int64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'sint64'} ) ); } when ('uint64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_uint64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'uint64'} ) ); } default { 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 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.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/ZMQ4/Raw.pm0000644000000000000000000001024113442351400014646 0ustar rootrootpackage ZMQ::FFI::ZMQ4::Raw; $ZMQ::FFI::ZMQ4::Raw::VERSION = '1.17'; 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' ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ4::Raw =head1 VERSION version 1.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/ZMQ2/0000755000000000000000000000000013442351400013557 5ustar rootrootZMQ-FFI-1.17/lib/ZMQ/FFI/ZMQ2/Context.pm0000644000000000000000000001035113442351400015541 0ustar rootroot# # Module Generated by Template::Tiny on Thu Mar 14 04:05:17 UTC 2019 # package ZMQ::FFI::ZMQ2::Context; $ZMQ::FFI::ZMQ2::Context::VERSION = '1.17'; 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 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.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/ZMQ2/Socket.pm0000644000000000000000000002777213442351400015364 0ustar rootroot# # Module Generated by Template::Tiny on Thu Mar 14 04:05:17 UTC 2019 # package ZMQ::FFI::ZMQ2::Socket; $ZMQ::FFI::ZMQ2::Socket::VERSION = '1.17'; 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) { when (/^(binary|string)$/) { # ZMQ_IDENTITY uses binary type and can be at most 255 bytes long # # ZMQ_LAST_ENDPOINT uses string type and expects a buffer large # enough to hold an endpoint string # # So for these cases 256 should be sufficient (including \0). # Other binary/string opts are being added all the time, and # hopefully this value scales, but we can always increase it if # necessary my $optval_ptr = malloc(256); $optval_len = 256; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_binary( $self->socket_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); } } when ('int') { $optval_len = $self->sockopt_sizes->{'int'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } when ('int64_t') { $optval_len = $self->sockopt_sizes->{'sint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_int64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } when ('uint64_t') { $optval_len = $self->sockopt_sizes->{'uint64'}; $self->check_error( 'zmq_getsockopt', zmq_getsockopt_uint64( $self->socket_ptr, $opt, \$optval, \$optval_len ) ); } default { 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) { when (/^(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 ) ); } when ('int') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'int'} ) ); } when ('int64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_int64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'sint64'} ) ); } when ('uint64_t') { $self->check_error( 'zmq_setsockopt', zmq_setsockopt_uint64( $self->socket_ptr, $opt, \$optval, $self->sockopt_sizes->{'uint64'} ) ); } default { 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 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.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/ZMQ2/Raw.pm0000644000000000000000000000627613442351400014661 0ustar rootrootpackage ZMQ::FFI::ZMQ2::Raw; $ZMQ::FFI::ZMQ2::Raw::VERSION = '1.17'; 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.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI/SocketRole.pm0000644000000000000000000000427313442351400015444 0ustar rootrootpackage ZMQ::FFI::SocketRole; $ZMQ::FFI::SocketRole::VERSION = '1.17'; 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); 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' ); 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'), }; } 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 ); 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::SocketRole =head1 VERSION version 1.17 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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.17/lib/ZMQ/FFI.pm0000644000000000000000000003634313442351400013375 0ustar rootrootpackage ZMQ::FFI; $ZMQ::FFI::VERSION = '1.17'; # 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.17 =head1 SYNOPSIS #### send/recv #### use v5.10; 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 v5.10; 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 v5.10; 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 v5.10; 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 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2019 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