t000755001750001750 012644573336 12221 5ustar00calidcalid000000000000ZMQ-FFI-1.11fd.t100644001750001750 145612644573336 13145 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse strict; use warnings; use Test::More; use Test::Warnings; use AnyEvent; use ZMQ::FFI qw(ZMQ_PUSH ZMQ_PULL); my $endpoint = "ipc://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; gc.t100644001750001750 310612644573336 13137 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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::Constants qw(ZMQ_REQ); use ZMQ::FFI::Util qw(zmq_version); my @gc_stack; my ($major) = 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); } else { 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); } 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.11000755001750001750 012644573336 12035 5ustar00calidcalid000000000000README100644001750001750 57412644573336 12764 0ustar00calidcalid000000000000ZMQ-FFI-1.11 This archive contains the distribution ZMQ-FFI, version 1.11: version agnostic Perl bindings for zeromq using ffi This software is copyright (c) 2016 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 v5.037. Changes100644001750001750 1333012644573336 13431 0ustar00calidcalid000000000000ZMQ-FFI-1.11 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 HACKING100644001750001750 47012644573336 13066 0ustar00calidcalid000000000000ZMQ-FFI-1.11$ cpanm -v Dist::Zilla # if not already installed $ dzil authordeps --missing | cpanm -v $ dzil listdeps --missing | cpanm -v $ dzil test # hack # repeat Note that the Socket modules are generated so edit them under inc/, not under lib/, and regenerate them using scripts/gen_modules.pl (or just rerun dzil) COPYING100644001750001750 4364512644573336 13205 0ustar00calidcalid000000000000ZMQ-FFI-1.11This 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 LICENSE100644001750001750 4364712644573336 13161 0ustar00calidcalid000000000000ZMQ-FFI-1.11This software is copyright (c) 2016 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) 2016 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) 2016 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 dist.ini100644001750001750 337512644573336 13572 0ustar00calidcalid000000000000ZMQ-FFI-1.11name = 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 = |} [PruneFiles] filename = scripts/gen_zmq_constants.pl [Git::NextVersion] version_regexp = ^(.+)$ [PkgVersion] [PodWeaver] [AutoPrereqs] [Prereqs / ConfigureRequires] FFI::Platypus = 0.33 [Prereqs / RuntimeRequires] perl = 5.010 Moo = 1.004005 Class::XSAccessor = 1.18 Math::BigInt = 1.997 FFI::Platypus = 0.33 [Run::BeforeBuild] run = perl scripts/gen_zmq_constants.pl run = perl scripts/gen_modules.pl [Run::Clean] run = rm -f lib/ZMQ/FFI/Constants.pm run = rm -f lib/ZMQ/FFI/ZMQ2/Socket.pm run = rm -f lib/ZMQ/FFI/ZMQ3/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] [InstallRelease] install_command = cpanm -v . [Clean] ; authordep Pod::Elemental::Transformer::List ; authordep Template::Tiny ; authordep Path::Class META.yml100644001750001750 233712644573336 13374 0ustar00calidcalid000000000000ZMQ-FFI-1.11--- 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' Scalar::Util: '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.33' dynamic_config: 0 generated_by: 'Dist::Zilla version 5.037, CPAN::Meta::Converter version 2.150005' 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.33' FFI::Platypus::Buffer: '0' FFI::Platypus::Memory: '0' Import::Into: '0' Math::BigInt: '1.997' Moo: '1.004005' Moo::Role: '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.11' MANIFEST100644001750001750 200212644573336 13241 0ustar00calidcalid000000000000ZMQ-FFI-1.11# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.037. COPYING Changes HACKING 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 inc/template/lib/ZMQ/FFI/Common/Socket.tt inc/template/lib/ZMQ/FFI/ZMQ2/Socket.pm.tt inc/template/lib/ZMQ/FFI/ZMQ3/Socket.pm.tt lib/ZMQ/FFI.pm lib/ZMQ/FFI/Constants.pm lib/ZMQ/FFI/ContextRole.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/Socket.pm lib/ZMQ/FFI/ZMQ3/Context.pm lib/ZMQ/FFI/ZMQ3/Socket.pm release.sh scripts/gen_modules.pl scripts/parallel-zmqlib-update.sh scripts/update-zmq-repo.sh t/close.t t/closed_socket.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 README.md100644001750001750 600712644573336 13400 0ustar00calidcalid000000000000ZMQ-FFI-1.11# 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 ### DOCUMENTATION ### https://metacpan.org/module/ZMQ::FFI proxy.t100644001750001750 320012644573336 13722 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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://test-zmq-ffi-$$-front"; my $worker_address = "ipc://test-zmq-ffi-$$-back"; # Set up the proxy in its own process my $proxy = fork; die "fork failed: $!" unless defined $proxy; if ( $proxy == 0 ) { # make sure child shuts down cleanly $SIG{TERM} = sub { exit 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"; }; # tear down the proxy do { # XXX # Occasionally the TERM signal handler does not actually fire, even # though kill returns 1 (indicating the child was successfully signaled). # As a result waitpid blocks, hanging the test. # # As a workaround until the problem is understood, check waitpid in a loop # and kill until the process actually exits kill TERM => $proxy; } while (waitpid($proxy, WNOHANG) > 0); done_testing; close.t100644001750001750 75112644573336 13636 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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://test-zmq-ffi-$$"); $s->send('ohhai'); }; ok !$timed_out, 'implicit Socket close done correctly (ctx destruction does not hang)'; }; done_testing; META.json100644001750001750 427412644573336 13546 0ustar00calidcalid000000000000ZMQ-FFI-1.11{ "abstract" : "version agnostic Perl bindings for zeromq using ffi", "author" : [ "Dylan Cali " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.037, CPAN::Meta::Converter version 2.150005", "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.33" } }, "runtime" : { "requires" : { "Carp" : "0", "Class::XSAccessor" : "1.18", "Exporter" : "0", "FFI::Platypus" : "0.33", "FFI::Platypus::Buffer" : "0", "FFI::Platypus::Memory" : "0", "Import::Into" : "0", "Math::BigInt" : "1.997", "Moo" : "1.004005", "Moo::Role" : "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", "Scalar::Util" : "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.11" } weaver.ini100644001750001750 5612644573336 14051 0ustar00calidcalid000000000000ZMQ-FFI-1.11[@Default] [-Transformer] transformer = List release.sh100755001750001750 10612644573336 14052 0ustar00calidcalid000000000000ZMQ-FFI-1.11#!/bin/bash set -e dzil build bash xt/test_versions.sh dzil release device.t100644001750001750 351112644573336 14005 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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://test-zmq-ffi-$$-front"; my $worker_address = "ipc://test-zmq-ffi-$$-back"; my $device; sub mkdevice { # make sure child shuts down cleanly $SIG{TERM} = sub { exit 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->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"; }; if ($device) { # tear down the device do { # see the reason for this workaround in proxy.t kill TERM => $device; } while (waitpid($device, WNOHANG) > 0); } done_testing; linger.t100644001750001750 142512644573336 14030 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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; unbind.t100644001750001750 156512644573336 14034 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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://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; pubsub.t100644001750001750 171012644573336 14045 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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://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; errors.t100644001750001750 664612644573336 14076 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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; }; 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://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://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://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://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; fork-02.t100644001750001750 673512644573336 13741 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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) = $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->(); } else { 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 { # 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) = $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->(); } else { 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->(); } exit; } done_testing; options.t100644001750001750 654712644573336 14255 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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://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; threads.t100644001750001750 270412644573336 14203 0ustar00calidcalid000000000000ZMQ-FFI-1.11/t 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"; } fork-01.t100644001750001750 513212644573336 13726 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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) = $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(); } else { 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(); } 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; unicode.t100644001750001750 314712644573336 14201 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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://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(); Makefile.PL100644001750001750 631012644573336 14070 0ustar00calidcalid000000000000ZMQ-FFI-1.11# This Makefile.PL for ZMQ-FFI was generated by # Dist::Zilla::Plugin::MakeMaker::Awesome 0.34. # 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 0.002001 use FFI::CheckLib; check_lib_or_exit( lib => 'zmq', ); use 5.010; 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.33" }, "DISTNAME" => "ZMQ-FFI", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.010", "NAME" => "ZMQ::FFI", "PREREQ_PM" => { "Carp" => 0, "Class::XSAccessor" => "1.18", "Exporter" => 0, "FFI::Platypus" => "0.33", "FFI::Platypus::Buffer" => 0, "FFI::Platypus::Memory" => 0, "Import::Into" => 0, "Math::BigInt" => "1.997", "Moo" => "1.004005", "Moo::Role" => 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, "Scalar::Util" => 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.11", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "AnyEvent" => 0, "Carp" => 0, "Class::XSAccessor" => "1.18", "Exporter" => 0, "ExtUtils::MakeMaker" => 0, "FFI::CheckLib" => "0.11", "FFI::Platypus" => "0.33", "FFI::Platypus::Buffer" => 0, "FFI::Platypus::Memory" => 0, "Import::Into" => 0, "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); multipart.t100644001750001750 244412644573336 14573 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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://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; send_recv.t100644001750001750 121512644573336 14515 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse strict; use warnings; use Test::More; use Test::Warnings; use ZMQ::FFI qw(ZMQ_REQ ZMQ_REP); my $endpoint = "ipc://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; xt000755001750001750 012644573336 12411 5ustar00calidcalid000000000000ZMQ-FFI-1.11sonames.pl100644001750001750 352412644573336 14557 0ustar00calidcalid000000000000ZMQ-FFI-1.11/xtuse 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://zmq-ffi-ctx2-$$"; my $v3_endpoint = "ipc://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; router-req.t100644001750001750 201712644573336 14653 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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://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; ZMQ000755001750001750 012644573336 13173 5ustar00calidcalid000000000000ZMQ-FFI-1.11/libFFI.pm100644001750001750 3564512644573336 14332 0ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQpackage ZMQ::FFI; $ZMQ::FFI::VERSION = '1.11'; # 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) = zmq_version($args{soname}); if ($major == 2) { require ZMQ::FFI::ZMQ2::Context; return ZMQ::FFI::ZMQ2::Context->new(%args); } else { require ZMQ::FFI::ZMQ3::Context; return ZMQ::FFI::ZMQ3::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.11 =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) 2016 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 bench000755001750001750 012644573336 13035 5ustar00calidcalid000000000000ZMQ-FFI-1.11zmq-bench.c100644001750001750 122112644573336 15221 0ustar00calidcalid000000000000ZMQ-FFI-1.11/bench#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); } closed_socket.t100644001750001750 122112644573336 15363 0ustar00calidcalid000000000000ZMQ-FFI-1.11/tuse 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-bench.pl100644001750001750 334712644573336 15425 0ustar00calidcalid000000000000ZMQ-FFI-1.11/benchuse 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); FFI000755001750001750 012644573336 13577 5ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQUtil.pm100644001750001750 720712644573336 15220 0ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQ/FFIpackage ZMQ::FFI::Util; $ZMQ::FFI::Util::VERSION = '1.11'; # 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.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.11 =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.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) 2016 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 test_versions.sh100755001750001750 276512644573336 16031 0ustar00calidcalid000000000000ZMQ-FFI-1.11/xt#!/bin/bash set -e function zmq_version { echo $(\ PERL5LIB=lib:$PERL5LIB \ perl -M'ZMQ::FFI::Util q(zmq_version)' \ -E 'print join " ",zmq_version'\ ) } function get_ld_dir { repodir="$HOME/git/$1" libzmq="$(find $repodir -type l -name libzmq.so)" if test -z "$libzmq"; then echo "No libzmq.so found in $repodir" >&2 return fi libzmq_dir="$(dirname $libzmq)" 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 test -z "$LD_LIBRARY_PATH" && exit 1 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 scripts000755001750001750 012644573336 13445 5ustar00calidcalid000000000000ZMQ-FFI-1.11gen_modules.pl100644001750001750 170712644573336 16450 0ustar00calidcalid000000000000ZMQ-FFI-1.11/scripts#!/usr/bin/env perl use strict; use warnings; use v5.10; use Template::Tiny; use Path::Class qw(file); my $tt = Template::Tiny->new(); my @socket_templates = ( file('inc/template/lib/ZMQ/FFI/ZMQ2/Socket.pm.tt'), file('inc/template/lib/ZMQ/FFI/ZMQ3/Socket.pm.tt') ); my $common_tt = file('inc/template/lib/ZMQ/FFI/Common/Socket.tt'); my $socket_check = q(if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; }); my $vars = { date => split("\n", scalar(qx{date -u})), closed_socket_check => $socket_check, }; for my $socket_tt (@socket_templates) { my $target = "$socket_tt"; $target =~ s{^inc/template/}{}g; $target =~ s{\.tt$}{}g; $target = file($target); my $input = $socket_tt->slurp(); $input .= $common_tt->slurp(); my $output; $tt->process(\$input, $vars, \$output); say "Generating '$target' from templates"; $target->spew($output); } Constants.pm100644001750001750 1445612644573336 16303 0ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQ/FFIpackage ZMQ::FFI::Constants; $ZMQ::FFI::Constants::VERSION = '1.11'; # ABSTRACT: Generated module of zmq constants. All constants, all versions. # Generated using ZMQ versions v2.1.0-v4.1.4 use strict; use warnings; use Exporter 'import'; our @EXPORT_OK = qw( ZMQ_AFFINITY ZMQ_BACKLOG ZMQ_CONFLATE ZMQ_CONNECT_RID 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_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_LISTENING ZMQ_EVENT_MONITOR_STOPPED ZMQ_FAIL_UNROUTABLE ZMQ_FD ZMQ_FORWARDER ZMQ_GSSAPI ZMQ_GSSAPI_PLAINTEXT ZMQ_GSSAPI_PRINCIPAL ZMQ_GSSAPI_SERVER ZMQ_GSSAPI_SERVICE_PRINCIPAL ZMQ_HANDSHAKE_IVL ZMQ_HAS_CAPABILITIES ZMQ_HAUSNUMERO ZMQ_HWM ZMQ_IDENTITY ZMQ_IDENTITY_FD ZMQ_IMMEDIATE 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_MAXMSGSIZE ZMQ_MAX_SOCKETS ZMQ_MAX_SOCKETS_DFLT ZMQ_MAX_VSM_SIZE ZMQ_MCAST_LOOP ZMQ_MECHANISM ZMQ_MORE ZMQ_MSG_MASK ZMQ_MSG_MORE ZMQ_MSG_SHARED ZMQ_MULTICAST_HOPS ZMQ_NOBLOCK 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_PROBE_ROUTER ZMQ_PUB ZMQ_PULL ZMQ_PUSH ZMQ_QUEUE 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_RAW ZMQ_SHARED ZMQ_SNDBUF ZMQ_SNDHWM ZMQ_SNDMORE ZMQ_SNDTIMEO ZMQ_SOCKET_LIMIT ZMQ_SOCKS_PROXY ZMQ_SRCFD ZMQ_STREAM ZMQ_STREAMER 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_THREAD_PRIORITY ZMQ_THREAD_SCHED_POLICY ZMQ_TOS ZMQ_TYPE ZMQ_UNSUBSCRIBE ZMQ_VSM ZMQ_XPUB ZMQ_XPUB_NODROP ZMQ_XPUB_VERBOSE ZMQ_XREP ZMQ_XREQ ZMQ_XSUB ZMQ_ZAP_DOMAIN zmq_msg_t_size ); our %EXPORT_TAGS = (all => [@EXPORT_OK]); sub ZMQ_AFFINITY { 4 } sub ZMQ_BACKLOG { 19 } sub ZMQ_CONFLATE { 54 } sub ZMQ_CONNECT_RID { 61 } 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_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_LISTENING { 8 } sub ZMQ_EVENT_MONITOR_STOPPED { 1024 } sub ZMQ_FAIL_UNROUTABLE { 33 } sub ZMQ_FD { 14 } sub ZMQ_FORWARDER { 2 } sub ZMQ_GSSAPI { 3 } sub ZMQ_GSSAPI_PLAINTEXT { 65 } sub ZMQ_GSSAPI_PRINCIPAL { 63 } sub ZMQ_GSSAPI_SERVER { 62 } sub ZMQ_GSSAPI_SERVICE_PRINCIPAL { 64 } sub ZMQ_HANDSHAKE_IVL { 66 } sub ZMQ_HAS_CAPABILITIES { 1 } sub ZMQ_HAUSNUMERO { 156384712 } sub ZMQ_HWM { 1 } sub ZMQ_IDENTITY { 5 } sub ZMQ_IDENTITY_FD { 67 } sub ZMQ_IMMEDIATE { 39 } 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_MAXMSGSIZE { 22 } 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_MORE { 1 } sub ZMQ_MSG_MASK { 129 } sub ZMQ_MSG_MORE { 1 } sub ZMQ_MSG_SHARED { 128 } sub ZMQ_MULTICAST_HOPS { 25 } sub ZMQ_NOBLOCK { 1 } 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_PROBE_ROUTER { 51 } sub ZMQ_PUB { 1 } sub ZMQ_PULL { 7 } sub ZMQ_PUSH { 8 } sub ZMQ_QUEUE { 3 } 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_RAW { 41 } 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_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_THREAD_PRIORITY { 3 } sub ZMQ_THREAD_SCHED_POLICY { 4 } sub ZMQ_TOS { 57 } sub ZMQ_TYPE { 16 } sub ZMQ_UNSUBSCRIBE { 7 } sub ZMQ_VSM { 32 } sub ZMQ_XPUB { 9 } sub ZMQ_XPUB_NODROP { 69 } sub ZMQ_XPUB_VERBOSE { 40 } sub ZMQ_XREP { 6 } sub ZMQ_XREQ { 5 } sub ZMQ_XSUB { 10 } sub ZMQ_ZAP_DOMAIN { 55 } 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.11 =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.1.4. It was generated using the zeromq2-x, zeromq3-x, zeromq4-x, and zeromq4-1 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) 2016 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 Versioner.pm100644001750001750 134612644573336 16255 0ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQ/FFIpackage ZMQ::FFI::Versioner; $ZMQ::FFI::Versioner::VERSION = '1.11'; 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.11 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 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 SocketRole.pm100644001750001750 410112644573336 16343 0ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQ/FFIpackage ZMQ::FFI::SocketRole; $ZMQ::FFI::SocketRole::VERSION = '1.11'; 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, ); # 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.11 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 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 ErrorHelper.pm100644001750001750 374212644573336 16534 0ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQ/FFIpackage ZMQ::FFI::ErrorHelper; $ZMQ::FFI::ErrorHelper::VERSION = '1.11'; 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.11 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 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 ContextRole.pm100644001750001750 234312644573336 16545 0ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQ/FFIpackage ZMQ::FFI::ContextRole; $ZMQ::FFI::ContextRole::VERSION = '1.11'; 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( get set socket proxy device destroy ); 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ContextRole =head1 VERSION version 1.11 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 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 ZMQ2000755001750001750 012644573336 14330 5ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQ/FFISocket.pm100644001750001750 3704212644573336 16304 0ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQ/FFI/ZMQ2# # Module Generated by Template::Tiny on Mon Jan 11 00:27:08 UTC 2016 # package ZMQ::FFI::ZMQ2::Socket; $ZMQ::FFI::ZMQ2::Socket::VERSION = '1.11'; use FFI::Platypus; use FFI::Platypus::Buffer; use FFI::Platypus::Memory qw(malloc free memcpy); use ZMQ::FFI::Constants qw(:all); use Carp qw(croak carp); use Try::Tiny; use Moo; use namespace::clean; no if $] >= 5.018, warnings => "experimental"; use feature 'switch'; with qw( ZMQ::FFI::SocketRole ZMQ::FFI::ErrorHelper ZMQ::FFI::Versioner ); my $FFI_LOADED; sub BUILD { my ($self) = @_; unless ($FFI_LOADED) { _load_common_ffi($self->soname); _load_zmq2_ffi($self->soname); $FFI_LOADED = 1; } # force init zmq_msg_t $self->_zmq_msg_t; # ensure clean edge state while ( $self->has_pollin ) { $self->recv(); } # set default linger $self->set_linger(0); } ### ZMQ2 API ### sub _load_zmq2_ffi { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname ); $ffi->attach( # int zmq_send(void *socket, zmq_msg_t *msg, int flags) 'zmq_send' => ['pointer', 'pointer', 'int'] => 'int' ); $ffi->attach( # int zmq_recv(void *socket, zmq_msg_t *msg, int flags) 'zmq_recv' => ['pointer', 'pointer', 'int'] => 'int' ); } # # send/recv are hot spots, so sacrificing some readability for performance # sub send { # 0: self # 1: data # 2: flags 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 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 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 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" ); } # vim:ft=perl ### ZMQ COMMON API ### use ZMQ::FFI::Util qw(current_tid); 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 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) ); } # # send/recv are hot spots, so sacrificing some readability for performance # 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_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 set_linger { my ($self, $linger) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_LINGER, 'int', $linger); } sub get_linger { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_LINGER, 'int'); } sub set_identity { my ($self, $id) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_IDENTITY, 'binary', $id); } sub get_identity { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_IDENTITY, 'binary'); } 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) = @_; return if $self->socket_ptr == -1; $self->close(); } sub _load_common_ffi { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname ); my $class = 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' => "${class}::zmq_getsockopt_binary"] => ['pointer', 'int', 'pointer', 'size_t*'] => 'int' ); $ffi->attach( ['zmq_getsockopt' => "${class}::zmq_getsockopt_int"] => ['pointer', 'int', 'int*', 'size_t*'] => 'int' ); $ffi->attach( ['zmq_getsockopt' => "${class}::zmq_getsockopt_int64"] => ['pointer', 'int', 'sint64*', 'size_t*'] => 'int' ); $ffi->attach( ['zmq_getsockopt' => "${class}::zmq_getsockopt_uint64"] => ['pointer', 'int', 'uint64*', 'size_t*'] => 'int' ); # int zmq_setsockopt(void *sock, int opt, const void *val, size_t len) $ffi->attach( ['zmq_setsockopt' => "${class}::zmq_setsockopt_binary"] => ['pointer', 'int', 'pointer', 'size_t'] => 'int' ); $ffi->attach( ['zmq_setsockopt' => "${class}::zmq_setsockopt_int"] => ['pointer', 'int', 'int*', 'size_t'] => 'int' ); $ffi->attach( ['zmq_setsockopt' => "${class}::zmq_setsockopt_int64"] => ['pointer', 'int', 'sint64*', 'size_t'] => 'int' ); $ffi->attach( ['zmq_setsockopt' => "${class}::zmq_setsockopt_uint64"] => ['pointer', 'int', 'uint64*', 'size_t'] => 'int' ); $ffi->attach( # int zmq_connect(void *socket, const char *endpoint) ['zmq_connect' => "${class}::zmq_connect"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_bind(void *socket, const char *endpoint) ['zmq_bind' => "${class}::zmq_bind"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_msg_init(zmq_msg_t *msg) ['zmq_msg_init' => "${class}::zmq_msg_init"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_msg_init_size(zmq_msg_t *msg, size_t size) ['zmq_msg_init_size' => "${class}::zmq_msg_init_size"] => ['pointer', 'int'] => 'int' ); $ffi->attach( # size_t zmq_msg_size(zmq_msg_t *msg) ['zmq_msg_size' => "${class}::zmq_msg_size"] => ['pointer'] => 'int' ); $ffi->attach( # void *zmq_msg_data(zmq_msg_t *msg) ['zmq_msg_data' => "${class}::zmq_msg_data"] => ['pointer'] => 'pointer' ); $ffi->attach( # int zmq_msg_close(zmq_msg_t *msg) ['zmq_msg_close' => "${class}::zmq_msg_close"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_close(void *socket) ['zmq_close' => "${class}::zmq_close"] => ['pointer'] => 'int' ); $ffi->attach( # const char *zmq_strerror(int errnum) ['zmq_strerror' => "${class}::zmq_strerror"] => ['int'] => 'string' ); $ffi->attach( # int zmq_errno(void) ['zmq_errno' => "${class}::zmq_errno"] => [] => 'int' ); } 1; # vim:ft=perl __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ2::Socket =head1 VERSION version 1.11 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 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 ZMQ3000755001750001750 012644573336 14331 5ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQ/FFISocket.pm100644001750001750 3715412644573336 16311 0ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQ/FFI/ZMQ3# # Module Generated by Template::Tiny on Mon Jan 11 00:27:08 UTC 2016 # package ZMQ::FFI::ZMQ3::Socket; $ZMQ::FFI::ZMQ3::Socket::VERSION = '1.11'; use FFI::Platypus; use FFI::Platypus::Buffer; use FFI::Platypus::Memory qw(malloc free memcpy); use ZMQ::FFI::Constants qw(:all); use Carp qw(croak carp); use Try::Tiny; use Moo; use namespace::clean; no if $] >= 5.018, warnings => "experimental"; use feature 'switch'; with qw( ZMQ::FFI::SocketRole ZMQ::FFI::ErrorHelper ZMQ::FFI::Versioner ); my $FFI_LOADED; sub BUILD { my ($self) = @_; unless ($FFI_LOADED) { _load_common_ffi($self->soname); _load_zmq3_ffi($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); } ### ZMQ3 API ### sub _load_zmq3_ffi { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname ); $ffi->attach( # int zmq_send(void *socket, void *buf, size_t len, int flags) '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' => ['pointer', 'pointer', 'int'] => 'int' ); $ffi->attach( # int zmq_unbind(void *socket, const char *endpoint) 'zmq_unbind' => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_disconnect(void *socket, const char *endpoint) 'zmq_disconnect' => ['pointer', 'string'] => 'int' ); } # # send/recv are hot spots, so sacrificing some readability for performance # 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 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 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 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) ); } # vim:ft=perl ### ZMQ COMMON API ### use ZMQ::FFI::Util qw(current_tid); 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 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) ); } # # send/recv are hot spots, so sacrificing some readability for performance # 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_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 set_linger { my ($self, $linger) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_LINGER, 'int', $linger); } sub get_linger { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_LINGER, 'int'); } sub set_identity { my ($self, $id) = @_; if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } $self->set(ZMQ_IDENTITY, 'binary', $id); } sub get_identity { if ($_[0]->socket_ptr == -1) { carp "Operation on closed socket"; return; } return $_[0]->get(ZMQ_IDENTITY, 'binary'); } 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) = @_; return if $self->socket_ptr == -1; $self->close(); } sub _load_common_ffi { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname ); my $class = 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' => "${class}::zmq_getsockopt_binary"] => ['pointer', 'int', 'pointer', 'size_t*'] => 'int' ); $ffi->attach( ['zmq_getsockopt' => "${class}::zmq_getsockopt_int"] => ['pointer', 'int', 'int*', 'size_t*'] => 'int' ); $ffi->attach( ['zmq_getsockopt' => "${class}::zmq_getsockopt_int64"] => ['pointer', 'int', 'sint64*', 'size_t*'] => 'int' ); $ffi->attach( ['zmq_getsockopt' => "${class}::zmq_getsockopt_uint64"] => ['pointer', 'int', 'uint64*', 'size_t*'] => 'int' ); # int zmq_setsockopt(void *sock, int opt, const void *val, size_t len) $ffi->attach( ['zmq_setsockopt' => "${class}::zmq_setsockopt_binary"] => ['pointer', 'int', 'pointer', 'size_t'] => 'int' ); $ffi->attach( ['zmq_setsockopt' => "${class}::zmq_setsockopt_int"] => ['pointer', 'int', 'int*', 'size_t'] => 'int' ); $ffi->attach( ['zmq_setsockopt' => "${class}::zmq_setsockopt_int64"] => ['pointer', 'int', 'sint64*', 'size_t'] => 'int' ); $ffi->attach( ['zmq_setsockopt' => "${class}::zmq_setsockopt_uint64"] => ['pointer', 'int', 'uint64*', 'size_t'] => 'int' ); $ffi->attach( # int zmq_connect(void *socket, const char *endpoint) ['zmq_connect' => "${class}::zmq_connect"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_bind(void *socket, const char *endpoint) ['zmq_bind' => "${class}::zmq_bind"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_msg_init(zmq_msg_t *msg) ['zmq_msg_init' => "${class}::zmq_msg_init"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_msg_init_size(zmq_msg_t *msg, size_t size) ['zmq_msg_init_size' => "${class}::zmq_msg_init_size"] => ['pointer', 'int'] => 'int' ); $ffi->attach( # size_t zmq_msg_size(zmq_msg_t *msg) ['zmq_msg_size' => "${class}::zmq_msg_size"] => ['pointer'] => 'int' ); $ffi->attach( # void *zmq_msg_data(zmq_msg_t *msg) ['zmq_msg_data' => "${class}::zmq_msg_data"] => ['pointer'] => 'pointer' ); $ffi->attach( # int zmq_msg_close(zmq_msg_t *msg) ['zmq_msg_close' => "${class}::zmq_msg_close"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_close(void *socket) ['zmq_close' => "${class}::zmq_close"] => ['pointer'] => 'int' ); $ffi->attach( # const char *zmq_strerror(int errnum) ['zmq_strerror' => "${class}::zmq_strerror"] => ['int'] => 'string' ); $ffi->attach( # int zmq_errno(void) ['zmq_errno' => "${class}::zmq_errno"] => [] => 'int' ); } 1; # vim:ft=perl __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ3::Socket =head1 VERSION version 1.11 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 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 update-zmq-repo.sh100755001750001750 114712644573336 17201 0ustar00calidcalid000000000000ZMQ-FFI-1.11/scripts#!/bin/bash -e repo=$1 test -z "$repo" && echo "usage: $(basename $0) " && exit 1 mkdir -p $HOME/git echo "Updating $repo lib" repodir="$HOME/git/$repo" if [ ! -d $repodir ]; then git clone https://github.com/zeromq/${repo} $repodir cd $repodir ./autogen.sh ./configure && make -j8 else cd $repodir hbefore="$(git show -s --pretty=format:%h)" git pull hafter="$(git show -s --pretty=format:%h)" libzmq="$(find -type l -name libzmq.so)" if [[ "$hbefore" != "$hafter" || -z "$libzmq" ]]; then ./autogen.sh ./configure && make -j8 fi fi Context.pm100644001750001750 1030712644573336 16473 0ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQ/FFI/ZMQ2package ZMQ::FFI::ZMQ2::Context; $ZMQ::FFI::ZMQ2::Context::VERSION = '1.11'; use FFI::Platypus; use ZMQ::FFI::Util qw(zmq_soname current_tid); use ZMQ::FFI::Constants qw(ZMQ_STREAMER); use ZMQ::FFI::ZMQ2::Socket; use Try::Tiny; use Moo; use namespace::clean; with qw( ZMQ::FFI::ContextRole ZMQ::FFI::ErrorHelper ZMQ::FFI::Versioner ); has '+threads' => ( default => 1, ); my $FFI_LOADED; sub BUILD { my ($self) = @_; unless ($FFI_LOADED) { _load_zmq2_ffi($self->soname); $FFI_LOADED = 1; } 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 _load_zmq2_ffi { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname ); $ffi->attach( # void *zmq_init(int io_threads) 'zmq_init' => ['int'] => 'pointer' ); $ffi->attach( # void *zmq_socket(void *context, int type) 'zmq_socket' => ['pointer', 'int'] => 'pointer' ); $ffi->attach( # int zmq_device(int device, const void *front, const void *back) 'zmq_device' => ['int', 'pointer', 'pointer'] => 'int' ); $ffi->attach( # int zmq_term(void *context) 'zmq_term' => ['pointer'] => 'int' ); $ffi->attach( # const char *zmq_strerror(int errnum) 'zmq_strerror' => ['int'] => 'string' ); $ffi->attach( # int zmq_errno(void) 'zmq_errno' => [] => 'int' ); } 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, type => $type, soname => $self->soname, ); } catch { die $_; }; push @{$self->sockets}, $socket; return $socket; } # zeromq v2 does not provide zmq_proxy # implemented here in terms of zmq_device 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 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 (@{$self->sockets}) { $socket->close() if defined $socket && $socket->socket_ptr != -1; } } $self->destroy(); } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ2::Context =head1 VERSION version 1.11 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 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 Context.pm100644001750001750 1061212644573336 16473 0ustar00calidcalid000000000000ZMQ-FFI-1.11/lib/ZMQ/FFI/ZMQ3package ZMQ::FFI::ZMQ3::Context; $ZMQ::FFI::ZMQ3::Context::VERSION = '1.11'; use FFI::Platypus; use ZMQ::FFI::Util qw(zmq_soname current_tid); use ZMQ::FFI::Constants qw(ZMQ_IO_THREADS ZMQ_MAX_SOCKETS); use ZMQ::FFI::ZMQ3::Socket; use Try::Tiny; 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) { _load_zmq3_ffi($self->soname); $FFI_LOADED = 1; } 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 _load_zmq3_ffi { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname ); $ffi->attach( # void *zmq_ctx_new() 'zmq_ctx_new' => [] => 'pointer' ); $ffi->attach( # int zmq_ctx_get(void *context, int option_name) 'zmq_ctx_get' => ['pointer', 'int'] => 'int' ); $ffi->attach( # int zmq_ctx_set(void *context, int option_name, int option_value) 'zmq_ctx_set' => ['pointer', 'int', 'int'] => 'int' ); $ffi->attach( # void *zmq_socket(void *context, int type) 'zmq_socket' => ['pointer', 'int'] => 'pointer' ); $ffi->attach( # int zmq_proxy(const void *front, const void *back, const void *cap) 'zmq_proxy' => ['pointer', 'pointer', 'pointer'] => 'int' ); $ffi->attach( # int zmq_ctx_destroy (void *context) 'zmq_ctx_destroy' => ['pointer'] => 'int' ); $ffi->attach( # const char *zmq_strerror(int errnum) 'zmq_strerror' => ['int'] => 'string' ); $ffi->attach( # int zmq_errno(void) 'zmq_errno' => [] => 'int' ); } 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, type => $type, soname => $self->soname, ); } catch { die $_; }; push @{$self->sockets}, $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 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 (@{$self->sockets}) { $socket->close() if defined $socket && $socket->socket_ptr != -1; } } $self->destroy(); } 1; __END__ =pod =encoding UTF-8 =head1 NAME ZMQ::FFI::ZMQ3::Context =head1 VERSION version 1.11 =head1 AUTHOR Dylan Cali =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2016 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 gc_global_destruction.pl100644001750001750 223312644573336 17442 0ustar00calidcalid000000000000ZMQ-FFI-1.11/xtuse 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-bench-subcriber.pl100644001750001750 125512644573336 17377 0ustar00calidcalid000000000000ZMQ-FFI-1.11/benchuse 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/; }; } parallel-zmqlib-update.sh100755001750001750 13712644573336 20475 0ustar00calidcalid000000000000ZMQ-FFI-1.11/scriptsparallel ./scripts/update-zmq-repo.sh <connect($endpoint)'; } $self->check_error( 'zmq_connect', zmq_connect($self->socket_ptr, $endpoint) ); } 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) ); } # # send/recv are hot spots, so sacrificing some readability for performance # 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_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 { [% closed_socket_check %] return $_[0]->get(ZMQ_FD, 'int'); } sub set_linger { my ($self, $linger) = @_; [% closed_socket_check %] $self->set(ZMQ_LINGER, 'int', $linger); } sub get_linger { [% closed_socket_check %] return $_[0]->get(ZMQ_LINGER, 'int'); } sub set_identity { my ($self, $id) = @_; [% closed_socket_check %] $self->set(ZMQ_IDENTITY, 'binary', $id); } sub get_identity { [% closed_socket_check %] return $_[0]->get(ZMQ_IDENTITY, 'binary'); } sub subscribe { my ($self, $topic) = @_; [% closed_socket_check %] $self->set(ZMQ_SUBSCRIBE, 'binary', $topic); } sub unsubscribe { my ($self, $topic) = @_; [% closed_socket_check %] $self->set(ZMQ_UNSUBSCRIBE, 'binary', $topic); } sub has_pollin { [% closed_socket_check %] return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLIN; } sub has_pollout { [% closed_socket_check %] return $_[0]->get(ZMQ_EVENTS, 'int') & ZMQ_POLLOUT; } 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 { 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 { my ($self) = @_; [% closed_socket_check %] # don't try to cleanup socket cloned from another thread return unless $self->_tid == current_tid(); # don't try to cleanup socket copied from another process (fork) return unless $self->_pid == $$; $self->check_error( 'zmq_msg_close', zmq_msg_close($self->_zmq_msg_t) ); $self->check_error( 'zmq_close', zmq_close($self->socket_ptr) ); $self->socket_ptr(-1); } sub DEMOLISH { my ($self) = @_; return if $self->socket_ptr == -1; $self->close(); } sub _load_common_ffi { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname ); my $class = 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' => "${class}::zmq_getsockopt_binary"] => ['pointer', 'int', 'pointer', 'size_t*'] => 'int' ); $ffi->attach( ['zmq_getsockopt' => "${class}::zmq_getsockopt_int"] => ['pointer', 'int', 'int*', 'size_t*'] => 'int' ); $ffi->attach( ['zmq_getsockopt' => "${class}::zmq_getsockopt_int64"] => ['pointer', 'int', 'sint64*', 'size_t*'] => 'int' ); $ffi->attach( ['zmq_getsockopt' => "${class}::zmq_getsockopt_uint64"] => ['pointer', 'int', 'uint64*', 'size_t*'] => 'int' ); # int zmq_setsockopt(void *sock, int opt, const void *val, size_t len) $ffi->attach( ['zmq_setsockopt' => "${class}::zmq_setsockopt_binary"] => ['pointer', 'int', 'pointer', 'size_t'] => 'int' ); $ffi->attach( ['zmq_setsockopt' => "${class}::zmq_setsockopt_int"] => ['pointer', 'int', 'int*', 'size_t'] => 'int' ); $ffi->attach( ['zmq_setsockopt' => "${class}::zmq_setsockopt_int64"] => ['pointer', 'int', 'sint64*', 'size_t'] => 'int' ); $ffi->attach( ['zmq_setsockopt' => "${class}::zmq_setsockopt_uint64"] => ['pointer', 'int', 'uint64*', 'size_t'] => 'int' ); $ffi->attach( # int zmq_connect(void *socket, const char *endpoint) ['zmq_connect' => "${class}::zmq_connect"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_bind(void *socket, const char *endpoint) ['zmq_bind' => "${class}::zmq_bind"] => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_msg_init(zmq_msg_t *msg) ['zmq_msg_init' => "${class}::zmq_msg_init"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_msg_init_size(zmq_msg_t *msg, size_t size) ['zmq_msg_init_size' => "${class}::zmq_msg_init_size"] => ['pointer', 'int'] => 'int' ); $ffi->attach( # size_t zmq_msg_size(zmq_msg_t *msg) ['zmq_msg_size' => "${class}::zmq_msg_size"] => ['pointer'] => 'int' ); $ffi->attach( # void *zmq_msg_data(zmq_msg_t *msg) ['zmq_msg_data' => "${class}::zmq_msg_data"] => ['pointer'] => 'pointer' ); $ffi->attach( # int zmq_msg_close(zmq_msg_t *msg) ['zmq_msg_close' => "${class}::zmq_msg_close"] => ['pointer'] => 'int' ); $ffi->attach( # int zmq_close(void *socket) ['zmq_close' => "${class}::zmq_close"] => ['pointer'] => 'int' ); $ffi->attach( # const char *zmq_strerror(int errnum) ['zmq_strerror' => "${class}::zmq_strerror"] => ['int'] => 'string' ); $ffi->attach( # int zmq_errno(void) ['zmq_errno' => "${class}::zmq_errno"] => [] => 'int' ); } 1; # vim:ft=perl ZMQ2000755001750001750 012644573336 16714 5ustar00calidcalid000000000000ZMQ-FFI-1.11/inc/template/lib/ZMQ/FFISocket.pm.tt100644001750001750 577312644573336 21304 0ustar00calidcalid000000000000ZMQ-FFI-1.11/inc/template/lib/ZMQ/FFI/ZMQ2# # Module Generated by Template::Tiny on [% date %] # package ZMQ::FFI::ZMQ2::Socket; use FFI::Platypus; use FFI::Platypus::Buffer; use FFI::Platypus::Memory qw(malloc free memcpy); use ZMQ::FFI::Constants qw(:all); use Carp qw(croak carp); use Try::Tiny; use Moo; use namespace::clean; no if $] >= 5.018, warnings => "experimental"; use feature 'switch'; with qw( ZMQ::FFI::SocketRole ZMQ::FFI::ErrorHelper ZMQ::FFI::Versioner ); my $FFI_LOADED; sub BUILD { my ($self) = @_; unless ($FFI_LOADED) { _load_common_ffi($self->soname); _load_zmq2_ffi($self->soname); $FFI_LOADED = 1; } # force init zmq_msg_t $self->_zmq_msg_t; # ensure clean edge state while ( $self->has_pollin ) { $self->recv(); } # set default linger $self->set_linger(0); } ### ZMQ2 API ### sub _load_zmq2_ffi { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname ); $ffi->attach( # int zmq_send(void *socket, zmq_msg_t *msg, int flags) 'zmq_send' => ['pointer', 'pointer', 'int'] => 'int' ); $ffi->attach( # int zmq_recv(void *socket, zmq_msg_t *msg, int flags) 'zmq_recv' => ['pointer', 'pointer', 'int'] => 'int' ); } # # send/recv are hot spots, so sacrificing some readability for performance # sub send { # 0: self # 1: data # 2: flags [% 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 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 disconnect { my ($self) = @_; [% closed_socket_check %] $self->bad_version( $self->verstr, "disconnect not available in zmq 2.x" ); } sub unbind { my ($self) = @_; [% closed_socket_check %] $self->bad_version( $self->verstr, "unbind not available in zmq 2.x" ); } # vim:ft=perl ZMQ3000755001750001750 012644573336 16715 5ustar00calidcalid000000000000ZMQ-FFI-1.11/inc/template/lib/ZMQ/FFISocket.pm.tt100644001750001750 610512644573336 21273 0ustar00calidcalid000000000000ZMQ-FFI-1.11/inc/template/lib/ZMQ/FFI/ZMQ3# # Module Generated by Template::Tiny on [% date %] # package ZMQ::FFI::ZMQ3::Socket; use FFI::Platypus; use FFI::Platypus::Buffer; use FFI::Platypus::Memory qw(malloc free memcpy); use ZMQ::FFI::Constants qw(:all); use Carp qw(croak carp); use Try::Tiny; use Moo; use namespace::clean; no if $] >= 5.018, warnings => "experimental"; use feature 'switch'; with qw( ZMQ::FFI::SocketRole ZMQ::FFI::ErrorHelper ZMQ::FFI::Versioner ); my $FFI_LOADED; sub BUILD { my ($self) = @_; unless ($FFI_LOADED) { _load_common_ffi($self->soname); _load_zmq3_ffi($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); } ### ZMQ3 API ### sub _load_zmq3_ffi { my ($soname) = @_; my $ffi = FFI::Platypus->new( lib => $soname ); $ffi->attach( # int zmq_send(void *socket, void *buf, size_t len, int flags) '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' => ['pointer', 'pointer', 'int'] => 'int' ); $ffi->attach( # int zmq_unbind(void *socket, const char *endpoint) 'zmq_unbind' => ['pointer', 'string'] => 'int' ); $ffi->attach( # int zmq_disconnect(void *socket, const char *endpoint) 'zmq_disconnect' => ['pointer', 'string'] => 'int' ); } # # send/recv are hot spots, so sacrificing some readability for performance # 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 { # 0: self # 1: flags [% closed_socket_check %] $_[0]->{last_errno} = 0; # retval = msg size my $retval = zmq_msg_recv($_[0]->{"_zmq_msg_t"}, $_[0]->socket_ptr, $_[1] // 0); if ( $retval == -1 ) { $_[0]->{last_errno} = zmq_errno(); if ($_[0]->die_on_error) { $_[0]->fatal('zmq_msg_recv'); } return; } if ($retval) { return buffer_to_scalar(zmq_msg_data($_[0]->{"_zmq_msg_t"}), $retval); } return ''; } sub 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 { my ($self, $endpoint) = @_; [% closed_socket_check %] unless ($endpoint) { croak 'usage: $socket->unbind($endpoint)'; } $self->check_error( 'zmq_unbind', zmq_unbind($self->socket_ptr, $endpoint) ); } # vim:ft=perl