ZeroMQ-0.23/000755 000765 000024 00000000000 12037235555 013412 5ustar00daisukestaff000000 000000 ZeroMQ-0.23/Changes000644 000765 000024 00000016610 12037235541 014704 0ustar00daisukestaff000000 000000 Changelog for Perl module ZeroMQ. 0.23 Oct 16 2012 - Oops, ZeroMQ::Raw version was not bumped. - Please consider this a goo timing to move to ZMQ::LibZMQ2, ZMQ::LibZMQ3, and ZMQ 0.22 Oct 11 2012 - Explicitly state that this module is deprecated in favor of ZMQ::LibZMQ2, ZMQ::LibZMQ3, and ZMQ. - No code changes. 0.21 Mar 22 2012 - Fix threading issues causing a segfault. martyn-gillmore/aero did the diagnosis on Win32, but that fix still caused problems in *nix, which showed a deeper problem. rafl provided a new patch, and hopefully this will fix the problem. * Initial fix by martyn-gillmore/aero: https://github.com/lestrrat/ZeroMQ-Perl/commit/baeb5233749233ced890141f5ab961fea1b1055d * Additional fix by rafl: https://github.com/lestrrat/ZeroMQ-Perl/commit/c9c7e0f1b98d7fc8336a612aa0b15f87964b3ef0 - Doc tweaks (smueller) - Add ROUTER/DEALER - HEADS UP: There are plans to ditch ZeroMQ.pm in favor of multiple implementations, to provide more stability: * https://github.com/lestrrat/p5-ZMQ/ * https://github.com/lestrrat/ZeroMQ-Perl/issues/36 * https://github.com/lestrrat/ZeroMQ-Perl/issues/35 0.20 Jan 12 2012 - Fix recv_as to return undef when ZMQ_NOBLOCK is specified (https://github.com/lestrrat/ZeroMQ-Perl/pull/31 by sebnow) - Make sure to not double-free C structures when explicit closing has been performed - Add ZMQ_RECONNECT_IVL_MAX in get/setsopckopt - Tweak automated tests 0.19 Dec 08 2011 - Fix socket/context destruction order (github #20). - Apply doc patches. - Make ZMQ_NOBLOCK to ZMQ_DONTWAIT when libzmq >= 3 - Change tests to using Test::Fatal instead of Test::Exception - Change tests to using Test::TCP object interface 0.18 Nov 06 2011 - Pass $flags in ZeroMQ::Socket->recv_as() as is documented 0.17 Fri Sep 09 2011 12:40 JST - Add support for ZMQ_LINGER in setsockopt (sebnow) https://github.com/lestrrat/ZeroMQ-Perl/pull/19 0.16 Sat Jul 23 2011 08:00 JST - Fix memory leaks * rt #69572 * https://github.com/lestrrat/ZeroMQ-Perl/pull/17 (linuxfood) - Make sure to check for libzmq 2.1.x, as we don't support anything else on this release 0.15 Mon May 23 2011 17:30 JST - Do not use PKG_CONFIG_PATH as the path to pkg-config binary. If for some reason you want to use a different pkg-config than in your PATH, use PKGCONFIG_CMD environmental variable. Reported by Johan Ström (rt #68108) - Doc tweaks - Fix/update autobuild tools used in Jenkins tests. 0.14 Thu May 12 2011 17:05 JST - Argh, forgot to change all the occurances of pkg-config to $pkg_config 0.13 Thu May 12 2011 17:00 JST - Fix problems introduced by using Devel::CheckLib + ZMQ_HOME et al. Problem reported by Johan Ström (rt #68108) - Respect PKG_CONFIG_PATH when probing for zeromq 0.12 Fri Apr 15 2011 15:35 JST - Add missing tools/detect_zmq.pl which implemented the detection scheme introduced in 0.11 0.11 Fri Apr 15 2011 15:30 JST - Make header, incpath, lib detection smarter. * Now supports pkg-config! * Environment variables ZMQ_HOME, ZMQ_INCLUDES, ZMQ_LIBS are honored. Please see POD for how to configure ZeroMQ.pm - Include a section on how to install in the POD. - Remove usage of DOWNSTREAM/UPSTREAM, and connect inproc sockets using PAIR 0.10 Wed Apr 13 2011 10:30 JST - Use Module::Instsall::CheckLib - Silence test failures [https://github.com/lestrrat/ZeroMQ-Perl/issues/11] (reported by oyvindsk) 0.09_01 Fri Mar 11 2011 08:00 JST - Add ZeroMQ::Poller (https://github.com/lestrrat/ZeroMQ-Perl/pull/8) 0.09 Wed Feb 16 2011 22:30 JST - Only run silly Module::Install hoopla if you're an author - Tweak Makefile.PL - Smarter zmq.h detection - Include Devel::CheckLib in requires 0.08 Sun Jan 23 2011 14:45 JST - Fixed many memory leaks (rt #64944) reported by Jason Ball * Plugged ZeroMQ::Raw::Message related leaks * Plugged leaks when setting $! * Wrote tests using zmq_poll() and AnyEvent to do non-blocking recv() with zeromq - Backwards incompatible change! zmq_send() now returns exactly what the underlying zeromq library returns -- previously it used to return a "true" value for success and false otherwise. 0.07 Tue Jan 18 2011 07:50 JST - Somehow zmq_device() was missing through 0.03 to 0.06. Re-added as ZeroMQ::Raw::zmq_device() 0.06 Tue Jan 18 2011 07:20 JST - Fix critical message corruption bug introduced by wrong usage of zmq_msg_init_data() (rt #64836). Reported, diagnosed by Jason Ball 0.05 Thu Jan 06 2011 19:20 JST - Various issues (rt #64520) reported by Jason Ball * Make sure to generate const-xs.inc and the like when installing * Tweak to work with perls older than 5.10 * Only generate README for authors 0.04 Wed Jan 05 2011 18:20 JST - Grr, remove autobuild stuff from MANIFEST, repackage. - Code is identical to 0.03 0.03 Wed Jan 05 2011 15:00 JST - Ad docs, and upload 0.03 0.02_05 Tue Jan 03 2011 00:30 JST - Add zmq_poll, with the ability to poll random file descriptors along with zmq sockets (rt #62851) 0.02_04 Tue Dec 29 2010 16:20 JST - Add zmq_msg_copy and zmq_msg_move - Fix minor compile warning - Make it so that ZeroMQ::Raw doesn't depend on ZeroMQ -- and other modules that it in turn depends on. Now ZeroMQ::Raw can be used standalone 0.02_03 Tue Dec 28 2010 21:40 JST - Rework the internals to allow high level API (perl-ish, OO) and low level API (straight portof zeromq C binding), thanks to jrockway - Remove PollItem in favor of getsockopt + ZMQ_FD. Holler if you need it back 0.02_02 Sat Oct 30 2010 21:20 JST - Update to work with zeromq2 master (as of 10/28) - Added new constants - ZMQ_POLLIN callbacks used to pass the ZeroMQ::Message argument to the callback function, but this is error prone, so now the callback does not receive anything 0.02_01 Mon Sep 06 2010 19:20 JST - Releasing a dev release to get some test coverage - Add zmq_poll support via ZeroMQ::PollItem - Lots of doc fixes - Lots of test fixes - For people cloning from github, tell them what Module::Install modules you need to install - Loudly tell the user that you're going to get a blocking socket even if you send a SIGINT/SIGTERM while it's in recv(). This is a problem in libzmq, and it is planned to be fixed on libzmq 2.1.x 0.02 Sat Aug 22 2010 09:00 JST - Changes from 0.01_01 to 0.02 were tested against zeromq-2.0.7 - Implement version() - Be more paranoid about getting an invalid object (with a bad struct) - House cleaning, and release a new version! 0.01_03 Thu Aug 20 2010 21:00 JST - Fake ZMQ_PULL and ZMQ_PUSH, which were introduced in git, but not in the released version - Use assert_lib() to die if zmq is not found - Implement socket close() 0.01_02 Thu Aug 20 2010 08:00 JST - No code change. - Add missing xs/const-xs.inc file - Add POD tests (author tests) 0.01_01 Thu Aug 19 2010 20:00 JST - Daisuke Maki (lestrrat) hacked the following: * Use plain XS -- only because I don't know C++ * Implemented serialization/deserialization * Worked on more thread safety * Updated constants * Implemented $ctxt->socket * Implemented $socket->send($plain_string) * Implemented ZeroMQ::device() * Implemented example scripts from http://zeromq.org/docs:introduction under eg/ 0.01 Tue Jul 13 2010 20:00 CET - Initial release ZeroMQ-0.23/eg/000755 000765 000024 00000000000 12037235555 014005 5ustar00daisukestaff000000 000000 ZeroMQ-0.23/inc/000755 000765 000024 00000000000 12037235555 014163 5ustar00daisukestaff000000 000000 ZeroMQ-0.23/lib/000755 000765 000024 00000000000 12037235555 014160 5ustar00daisukestaff000000 000000 ZeroMQ-0.23/Makefile.PL000644 000765 000024 00000003515 12037235040 015355 0ustar00daisukestaff000000 000000 BEGIN { if (-e '.git') { do 'tools/check_mi_mods.pl'; } else { unshift @INC, 'inc'; require inc::Module::Install; Module::Install->import; } } name 'ZeroMQ'; { # M::I is silly about multiple authors: my $mainpm = 'lib/ZeroMQ.pm'; name_from $mainpm; version_from $mainpm; perl_version_from $mainpm; license_from $mainpm; abstract_from $mainpm; author 'Daisuke Maki '; author 'Steffen Mueller '; if ($Module::Install::AUTHOR) { readme_from $mainpm; } } do 'tools/detect_zmq.pl'; print "Detected the following ZMQ settings:\n"; foreach my $env (qw(ZMQ_HOME ZMQ_H ZMQ_INCLUDES ZMQ_LIBS ZMQ_TRACE)) { printf " + %s = %s\n", $env, exists $ENV{$env} ? $ENV{$env} : "(null)"; } # XXX As of Devel::CheckLib 0.93, it seems like LIBS = "-L/path/to/foo" # gets ignored (unlike what the docs say). So we manually strip and # re-arrange the paths here assertlibs lib => 'zmq', header => 'zmq.h', incpath => [ split /\s+/, $ENV{ZMQ_INCLUDES} ], libpath => [ grep { -d $_ } map { s/^-L//; $_ } split /\s+/, $ENV{ZMQ_LIBS} ] ; repository 'http://github.com/lestrrat/ZeroMQ-Perl'; requires 'Task::Weaken'; test_requires 'Test::More', '0.98'; test_requires 'Test::TCP' => '1.08'; test_requires 'Test::Requires'; test_requires 'Test::Fatal'; recommends 'JSON' => '2.00'; use_xshelper '-clean'; use_ppport; cc_warnings; cc_include_paths split/\s+/, $ENV{ZMQ_INCLUDES}; cc_libs $ENV{ZMQ_LIBS}; cc_include_paths 'xs'; cc_src_paths 'xs'; cc_assert_lib 'zmq'; cc_libs 'zmq', 'uuid'; # uuid for cygwin, but can't hurt if ($ENV{ZMQ_TRACE}) { cc_define qq|-DPERLZMQ_TRACE=$ENV{ZMQ_TRACE}|; } default_test_target env => { LC_ALL => 'C' } ; author_tests 'xt'; clean_files "xs/*.inc"; do 'tools/genfiles.pl'; WriteAll;ZeroMQ-0.23/MANIFEST000644 000765 000024 00000002454 12037235040 014535 0ustar00daisukestaff000000 000000 Changes eg/hello_client.pl eg/hello_server.pl eg/local_lat.pl eg/pubsub_client.pl eg/pubsub_server.pl eg/remote_lat.pl eg/thread_0mq.pl eg/threaded_client.pl eg/threaded_server.pl inc/Devel/CheckLib.pm inc/Module/Install.pm inc/Module/Install/AuthorTests.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/CheckLib.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/ReadmeFromPod.pm inc/Module/Install/TestTarget.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm inc/Module/Install/XSUtil.pm lib/ZeroMQ.pm lib/ZeroMQ/Constants.pm lib/ZeroMQ/Context.pm lib/ZeroMQ/Message.pm lib/ZeroMQ/Poller.pm lib/ZeroMQ/Raw.pm lib/ZeroMQ/Socket.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml MYMETA.json README t/000_compile.t t/001_context.t t/002_socket.t t/003_message.t t/004_version.t t/005_poll.t t/006_anyevent.t t/100_basic.t t/101_threads.t t/103_json.t t/104_ipc.t t/105_poll.t t/cover.sh t/rt64944.t t/rt74653.t tools/check_mi_mods.pl tools/detect_zmq.pl tools/genfiles.pl xs/perl_zeromq.h xs/perl_zeromq.xs xt/100_eg_hello_world.t xt/101_eg_pubsub.t xt/102_eg_threaded.t xt/103_eg_xreqxrep.t xt/999_leak.t xt/999_pod-coverage.t xt/999_pod.t xt/pubsub_stress.t xt/rt64836.t xt/rt64836_lowlevel.t xt/rt64944.t ZeroMQ-0.23/MANIFEST.SKIP000644 000765 000024 00000001377 12037235040 015305 0ustar00daisukestaff000000 000000 # Avoid archives of this distribution \bZeroMQ-\d+\.\d+(?:_\d+)?\.tar\.gz$ # Avoid version control files. \bRCS\b \bCVS\b ,v$ \B\.svn\b \B\.cvsignore$ # Avoid Makemaker generated and utility files. \bMakefile$ \bblib \bMakeMaker-\d \bpm_to_blib$ \bblibdirs$ # Avoid Module::Build generated and utility files. \bBuild$ \bBuild.bat$ \b_build # Avoid Devel::Cover generated files \bcover_db # Avoid temp and backup files. ~$ \.tmp$ \.o$ \.old$ \.bak$ \#$ \.# \.rej$ \.swp$ \.swo$ \.bs$ # Avoid OS-specific files/dirs # Mac OSX metadata \B\.DS_Store # Mac OSX SMB mount metadata files \B\._ \bbuildtmp\b \.git\b \.gitignore\b ^MYMETA.yml$ ^xs/mg-xs.inc$ ^xs/const-xs.inc$ ^xs/typemap$ ^xs/perl_zeromq.c$ ^build\b ^build.pl$ ^install\b ^extlib\b ^autobuild ZeroMQ-0.23/META.yml000644 000765 000024 00000001614 12037235554 014664 0ustar00daisukestaff000000 000000 --- abstract: 'A ZeroMQ2 wrapper for Perl (DEPRECATED)' author: - 'Daisuke Maki ' - 'Steffen Mueller ' build_requires: Devel::CheckLib: 0.4 Devel::PPPort: 3.19 ExtUtils::MakeMaker: 6.59 Test::Fatal: 0 Test::More: 0.98 Test::Requires: 0 Test::TCP: 1.08 configure_requires: Devel::CheckLib: 0.4 Devel::PPPort: 3.19 ExtUtils::MakeMaker: 6.59 ExtUtils::ParseXS: 2.21 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 module_name: ZeroMQ name: ZeroMQ no_index: directory: - inc - t - xt recommends: JSON: 2.00 requires: Task::Weaken: 0 XSLoader: 0.02 perl: 5.8.0 resources: license: http://dev.perl.org/licenses/ repository: http://github.com/lestrrat/ZeroMQ-Perl version: 0.23 ZeroMQ-0.23/MYMETA.json000644 000765 000024 00000003204 12037235554 015277 0ustar00daisukestaff000000 000000 { "abstract" : "A ZeroMQ2 wrapper for Perl (DEPRECATED)", "author" : [ "Daisuke Maki ", "Steffen Mueller " ], "dynamic_config" : 0, "generated_by" : "Module::Install version 1.06, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "ZeroMQ", "no_index" : { "directory" : [ "inc", "t", "xt" ] }, "prereqs" : { "build" : { "requires" : { "Devel::CheckLib" : "0.4", "Devel::PPPort" : "3.19", "ExtUtils::MakeMaker" : "6.59", "ExtUtils::ParseXS" : "2.21", "Test::Fatal" : "0", "Test::More" : "0.98", "Test::Requires" : "0", "Test::TCP" : "1.08" } }, "configure" : { "requires" : { "Devel::CheckLib" : "0.4", "Devel::PPPort" : "3.19", "ExtUtils::MakeMaker" : "6.59", "ExtUtils::ParseXS" : "2.21" } }, "runtime" : { "recommends" : { "JSON" : "2.00" }, "requires" : { "Task::Weaken" : "0", "XSLoader" : "0.02", "perl" : "5.008" } } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "http://github.com/lestrrat/ZeroMQ-Perl" } }, "version" : "0.22", "x_module_name" : "ZeroMQ" } ZeroMQ-0.23/README000644 000765 000024 00000024006 12037235553 014272 0ustar00daisukestaff000000 000000 NAME ZeroMQ - A ZeroMQ2 wrapper for Perl (DEPRECATED) SYNOPSIS ( HIGH-LEVEL API ) # echo server use ZeroMQ qw/:all/; my $cxt = ZeroMQ::Context->new; my $sock = $cxt->socket(ZMQ_REP); $sock->bind($addr); my $msg; foreach (1..$roundtrip_count) { $msg = $sock->recv(); $sock->send($msg); } # json (if JSON.pm is available) $sock->send_as( json => { foo => "bar" } ); my $thing = $sock->recv_as( "json" ); # custom serialization ZeroMQ::register_read_type(myformat => sub { ... }); ZeroMQ::register_write_type(myformat => sub { .. }); $sock->send_as( myformat => $data ); # serialize using above callback my $thing = $sock->recv_as( "myformat" ); SYNOPSIS ( LOW-LEVEL API ) use ZeroMQ::Raw; my $ctxt = zmq_init($threads); my $rv = zmq_term($ctxt); my $msg = zmq_msg_init(); my $msg = zmq_msg_init_size( $size ); my $msg = zmq_msg_init_data( $data ); my $rv = zmq_msg_close( $msg ); my $rv = zmq_msg_move( $dest, $src ); my $rv = zmq_msg_copy( $dest, $src ); my $data = zmq_msg_data( $msg ); my $size = zmq_msg_size( $msg); my $sock = zmq_socket( $ctxt, $type ); my $rv = zmq_close( $sock ); my $rv = zmq_setsockopt( $socket, $option, $value ); my $val = zmq_getsockopt( $socket, $option ); my $rv = zmq_bind( $sock, $addr ); my $rv = zmq_send( $sock, $msg, $flags ); my $msg = zmq_recv( $sock, $flags ); INSTALLATION If you have libzmq registered with pkg-config: perl Makefile.PL make make test make install If you don't have pkg-config, and libzmq is installed under /usr/local/libzmq: ZMQ_HOME=/usr/local/libzmq \ perl Makefile.PL make make test make install If you want to customize include directories and such: ZMQ_INCLUDES=/path/to/libzmq/include \ ZMQ_LIBS=/path/to/libzmq/lib \ ZMQ_H=/path/to/libzmq/include/zmq.h \ perl Makefile.PL make make test make install If you want to compile with debugging on: perl Makefile.PL -g DESCRIPTION Please note that this module has been DEPRECATED in favor of ZMQ::LibZMQ2, ZMQ::LibZMQ3, and ZMQ. see https://github.com/lestrrat/p5-ZMQ and other CPAN pages. The "ZeroMQ" module is a wrapper of the 0MQ message passing library for Perl. It's a thin wrapper around the C API. Please read for more details on ZeroMQ. CLASS WALKTHROUGH ZeroMQ::Raw Use ZeroMQ::Raw to get access to the C API such as "zmq_init", "zmq_socket", et al. Functions provided in this low level API should follow the C API exactly. ZeroMQ::Constants ZeroMQ::Constants contains all of the constants that are known to be extractable from zmq.h. Do note that sometimes the list changes due to additions/deprecations in the underlying zeromq2 library. We try to do our best to make things available (at least to warn you that some symbols are deprecated), but it may not always be possible. ZeroMQ::Context ZeroMQ::Socket ZeroMQ::Message ZeroMQ::Context, ZeroMQ::Socket, ZeroMQ::Message contain the high-level, more perl-ish interface to the zeromq functionalities. ZeroMQ Loading "ZeroMQ" will make the ZeroMQ::Context, ZeroMQ::Socket, and ZeroMQ::Message classes available as well. BASIC USAGE To start using ZeroMQ, you need to create a context object, then as many ZeroMQ::Socket as you need: my $ctxt = ZeroMQ::Context->new; my $socket = $ctxt->socket( ... options ); You need to call "bind()" or "connect()" on the socket, depending on your usage. For example on a typical server-client model you would write on the server side: $socket->bind( "tcp://127.0.0.1:9999" ); and on the client side: $socket->connect( "tcp://127.0.0.1:9999" ); The underlying zeromq library offers TCP, multicast, in-process, and ipc connection patterns. Read the zeromq manual for more details on other ways to setup the socket. When sending data, you can either pass a ZeroMQ::Message object or a Perl string. # the following two send() calls are equivalent my $msg = ZeroMQ::Message->new( "a simple message" ); $socket->send( $msg ); $socket->send( "a simple message" ); In most cases using ZeroMQ::Message is redundunt, so you will most likely use the string version. To receive, simply call "recv()" on the socket my $msg = $socket->recv; The received message is an instance of ZeroMQ::Message object, and you can access the content held in the message via the "data()" method: my $data = $msg->data; SERIALIZATION ZeroMQ.pm comes with a simple serialization/deserialization mechanism. To serialize, use "register_write_type()" to register a name and an associated callback to serialize the data. For example, for JSON we do the following (this is already done for you in ZeroMQ.pm if you have JSON.pm installed): use JSON (); ZeroMQ::register_write_type('json' => \&JSON::encode_json); ZeroMQ::register_read_type('json' => \&JSON::decode_json); Then you can use "send_as()" and "recv_as()" to specify the serialization type as the first argument: my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket( ZMQ_REQ ); $sock->send_as( json => $complex_perl_data_structure ); The otherside will receive a JSON encoded data. The receivind side can be written as: my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket( ZMQ_REP ); my $complex_perl_data_structure = $sock->recv_as( 'json' ); If you have JSON.pm (must be 2.00 or above), then the JSON serializer / deserializer is automatically enabled. If you want to tweak the serializer option, do something like this: my $coder = JSON->new->utf8->pretty; # pretty print ZeroMQ::register_write_type( json => sub { $coder->encode($_[0]) } ); ZeroMQ::register_read_type( json => sub { $coder->decode($_[0]) } ); Note that this will have a GLOBAL effect. If you want to change only your application, use a name that's different from 'json'. ASYNCHRONOUS I/O WITH ZEROMQ By default ZeroMQ comes with its own zmq_poll() mechanism that can handle non-blocking sockets. You can use this by calling zmq_poll with a list of hashrefs: zmq_poll([ { fd => fileno(STDOUT), events => ZMQ_POLLOUT, callback => \&callback, }, { socket => $zmq_socket, events => ZMQ_POLLIN, callback => \&callback }, ], $timeout ); Unfortunately this custom polling scheme doesn't play too well with AnyEvent. As of zeromq2-2.1.0, you can use getsockopt to retrieve the underlying file descriptor, so use that to integrate ZeroMQ and AnyEvent: my $socket = zmq_socket( $ctxt, ZMQ_REP ); my $fh = zmq_getsockopt( $socket, ZMQ_FD ); my $w; $w = AE::io $fh, 0, sub { while ( my $msg = zmq_recv( $socket, ZMQ_RCVMORE ) ) { # do something with $msg; } undef $w; }; NOTES ON MULTI-PROCESS and MULTI-THREADED USAGE ZeroMQ works on both multi-process and multi-threaded use cases, but you need to be careful bout sharing ZeroMQ objects. For multi-process environments, you should not be sharing the context object. Create separate contexts for each process, and therefore you shouldn't be sharing the socket objects either. For multi-thread environemnts, you can share the same context object. However you cannot share sockets. FUNCTIONS version() Returns the version of the underlying zeromq library that is being linked. In scalar context, returns a dotted version string. In list context, returns a 3-element list of the version numbers: my $version_string = ZeroMQ::version(); my ($major, $minor, $patch) = ZeroMQ::version(); device($type, $sock1, $sock2) register_read_type($name, \&callback) Register a read callback for a given $name. This is used in "recv_as()". The callback receives the data received from the socket. register_write_type($name, \&callback) Register a write callback for a given $name. This is used in "send_as()" The callback receives the Perl structure given to "send_as()" DEBUGGING XS If you see segmentation faults, and such, you need to figure out where the error is occuring in order for the maintainers to figure out what happened. Here's a very very brief explanation of steps involved. First, make sure to compile ZeroMQ.pm with debugging on by specifying -g: perl Makefile.PL -g make Then fire gdb: gdb perl (gdb) R -Mblib /path/to/your/script.pl When you see the crash, get a backtrace: (gdb) bt CAVEATS This is an early release. Proceed with caution, please report (or better yet: fix) bugs you encounter. This module has been tested againt zeromq 2.1.4. Semantics of this module rely heavily on the underlying zeromq version. Make sure you know which version of zeromq you're working with. SEE ALSO ZeroMQ::Raw, ZeroMQ::Context, ZeroMQ::Socket, ZeroMQ::Message AUTHOR Daisuke Maki "" Steffen Mueller, "" COPYRIGHT AND LICENSE The ZeroMQ module is Copyright (C) 2010 by Daisuke Maki This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.0 or, at your option, any later version of Perl 5 you may have available. ZeroMQ-0.23/t/000755 000765 000024 00000000000 12037235555 013655 5ustar00daisukestaff000000 000000 ZeroMQ-0.23/tools/000755 000765 000024 00000000000 12037235555 014552 5ustar00daisukestaff000000 000000 ZeroMQ-0.23/xs/000755 000765 000024 00000000000 12037235555 014044 5ustar00daisukestaff000000 000000 ZeroMQ-0.23/xt/000755 000765 000024 00000000000 12037235555 014045 5ustar00daisukestaff000000 000000 ZeroMQ-0.23/xt/100_eg_hello_world.t000644 000765 000024 00000001262 12037235040 017565 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::TCP; BEGIN { use_ok "ZeroMQ", qw(ZMQ_REQ ZMQ_REP); } my $server = Test::TCP->new( code => sub { my $port = shift; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_REP); $sock->bind( "tcp://127.0.0.1:$port" ); my $message = $sock->recv(); is $message->data, "hello", "server receives correct data"; $sock->send("world"); exit 0; } ); my $port = $server->port; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_REQ); $sock->connect( "tcp://127.0.0.1:$port" ); $sock->send("hello"); my $message = $sock->recv(); is $message->data, "world", "client receives correct data"; done_testing;ZeroMQ-0.23/xt/101_eg_pubsub.t000644 000765 000024 00000002170 12037235040 016553 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::TCP; BEGIN { use_ok "ZeroMQ", qw(ZMQ_PUB ZMQ_SUB ZMQ_SUBSCRIBE ZMQ_POLLIN ZMQ_NOBLOCK); } test_tcp( client => sub { my $port = shift; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_SUB); $sock->connect( "tcp://127.0.0.1:$port" ); $sock->setsockopt(ZMQ_SUBSCRIBE, "W"); my $message = $sock->recv; is $message->data, "WORLD?"; }, server => sub { my $port = shift; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_PUB); $sock->bind( "tcp://127.0.0.1:$port" ); # if this server goes away before the client can recv(), the # client waits hanging local $SIG{ALRM} = sub { die "ZMQ_ALRM_TIMEOUT"; }; eval { alarm(10); my @message = qw(HELLO? WORLD? HELLO? HELLO?); while(1) { my $message = shift @message; if ($message) { $sock->send($message); } sleep 1 } }; } ); done_testing;ZeroMQ-0.23/xt/102_eg_threaded.t000644 000765 000024 00000003353 12037235040 017040 0ustar00daisukestaff000000 000000 BEGIN { require Config; if (!$Config::Config{useithreads}) { print "1..0 # Skip: no ithreads\n"; exit 0; } } use strict; # XXX use Test::More before use threads to fool Test::More, which # doesn't play nicely with Test::SharedFork use Test::More; use threads; use Test::Requires 'Test::TCP'; BEGIN { use_ok "ZeroMQ", qw(ZMQ_REQ ZMQ_XREQ ZMQ_XREP ZMQ_REQ ZMQ_REP ZMQ_QUEUE); } test_tcp( client => sub { my $port = shift; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_REQ); $sock->connect( "tcp://127.0.0.1:$port" ); for (1..10) { $sock->send("Hello $$"); my $message = $sock->recv(); } $sock->send("END") for 1..5; }, server => sub { my $port = shift; my $ctxt = ZeroMQ::Context->new(); my $clients = $ctxt->socket(ZMQ_XREP); my $workers = $ctxt->socket(ZMQ_XREQ); $clients->bind( "tcp://127.0.0.1:$port" ); $workers->bind( "inproc://workers" ); my @threads; for (1..5) { push @threads, threads->create( sub { my $ctxt = shift; my $wsock = $ctxt->socket(ZMQ_REP); $wsock->connect( "inproc://workers" ); my $loop = 1; while ($loop) { my $message = $wsock->recv; if ($message->data eq 'END') { $loop = 0; } else { $wsock->send( "World " . threads->tid() ); } } }, $ctxt ); } ZeroMQ::device(ZMQ_QUEUE, $clients, $workers); $_->join for @threads; ok(1); } ); done_testing;ZeroMQ-0.23/xt/103_eg_xreqxrep.t000644 000765 000024 00000002573 12037235040 017142 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::TCP; use Test::Requires 'Parallel::Prefork'; use File::Temp; BEGIN { use_ok "ZeroMQ", qw(ZMQ_REQ ZMQ_REP ZMQ_POLLOUT ZMQ_NOBLOCK); } my $parent; test_tcp( server => sub { my $port = shift; my $ctxt = ZeroMQ::Context->new; my $socket = $ctxt->socket(ZMQ_REP); $socket->bind( "tcp://127.0.0.1:$port"); while ( 1 ) { my $msg = $socket->recv; next unless $msg; $socket->send("Thank you " . $msg->data); } }, client => sub { my $port = shift; sleep 2; my %children; foreach (1..3) { my $pid = fork(); if (! defined $pid) { die "Could not fork"; } elsif ($pid) { $parent = $$; $children{$pid}++; } else { my $ctxt = ZeroMQ::Context->new(); my $client = $ctxt->socket( ZMQ_REQ ); $client->connect("tcp://127.0.0.1:$port"); $client->send($$); my $msg = $client->recv(); is $msg->data, "Thank you $$", "child $$ got reply '" . $msg->data . "'"; exit 0; } } while (%children) { if ( my $pid = wait ) { delete $children{$pid}; } } } ); done_testing; ZeroMQ-0.23/xt/999_leak.t000644 000765 000024 00000000564 12037235040 015552 0ustar00daisukestaff000000 000000 use strict; use Test::More; BEGIN { if (! $ENV{TEST_LEAK}) { plan skip_all => "Set TEST_LEAK to run leak tests"; } } use Test::Requires 'Test::Valgrind', 'XML::Parser', ; while ( my $f = ) { subtest $f => sub { do $f }; } while ( my $f = ) { for my $i (1..10) { subtest $f => sub { do $f }; } } done_testing;ZeroMQ-0.23/xt/999_pod-coverage.t000644 000765 000024 00000000250 12037235040 017201 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::Requires; test_requires 'Test::Pod::Coverage'; Test::Pod::Coverage::all_pod_coverage_ok({ trustme => [ qr/^[A-Z_]+$/ ], }); ZeroMQ-0.23/xt/999_pod.t000644 000765 000024 00000000136 12037235040 015413 0ustar00daisukestaff000000 000000 use Test::More; use Test::Requires; test_requires 'Test::Pod'; Test::Pod::all_pod_files_ok();ZeroMQ-0.23/xt/pubsub_stress.t000644 000765 000024 00000004055 12037235040 017126 0ustar00daisukestaff000000 000000 use strict; use Test::Requires qw( Data::UUID Parallel::ForkManager Time::HiRes Test::SharedFork ); use Test::More; use ZeroMQ::Raw; use ZeroMQ::Constants qw(:all); run(); sub run { my $max = 1_000; # 1_000_000; my $port = 9999; my @prefixes = (0..9, 'A'..'Z'); my $pm = Parallel::ForkManager->new(36); foreach my $prefix ( @prefixes ) { $pm->start() and next; eval { run_client( $port, $prefix ) }; warn if $@; $pm->finish; } my $uuid = Data::UUID->new; my $ctxt = zmq_init(); my $socket = zmq_socket( $ctxt, ZMQ_PUB ); zmq_bind( $socket, "tcp://127.0.0.1:$port" ); for ( 1 .. $max ) { my $data = $uuid->create_from_name_str( "pubsub_stress", join( ".", Time::HiRes::time(), {}, rand(), $$ ) ); # warn "sending $data"; zmq_send( $socket, $data ); } for my $prefix ( 0..9, 'A' ..'Z' ) { zmq_send( $socket, "$prefix-EXIT" ); } # warn "now waiting..."; $pm->wait_all_children; zmq_close( $socket ); zmq_term($ctxt); done_testing(); } sub run_client { my ($port, $prefix) = @_; my $ctxt = zmq_init(); my $socket = zmq_socket( $ctxt, ZMQ_SUB ); zmq_connect( $socket, "tcp://127.0.0.1:$port" ); # warn "connected..."; zmq_setsockopt( $socket, ZMQ_SUBSCRIBE, $prefix ); # warn "subscribing to $prefix"; my $loop = 1; while (1) { zmq_poll([ { socket => $socket, events => ZMQ_POLLIN, callback => sub { while (my $msg = zmq_recv( $socket, ZMQ_RCVMORE )) { my $data = zmq_msg_data( $msg ); # warn $data; if ($data =~ /-EXIT$/ ) { $loop = 0; } } } } ], 1000000); last unless $loop; } # warn "child for $prefix done"; zmq_close( $socket ); zmq_term( $ctxt ); ok(1); } 1; ZeroMQ-0.23/xt/rt64836.t000644 000765 000024 00000002764 12037235040 015270 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::Requires qw( Test::TCP ); use ZeroMQ qw(ZMQ_PUB ZMQ_SUB ZMQ_SNDMORE); use Time::HiRes qw(usleep); BEGIN { use_ok "ZeroMQ"; use_ok "ZeroMQ::Constants", ":all"; } my $max = $ENV{ MSGCOUNT } || 100; note "Using $max messages to test - set MSGCOUNT to a different number if you want to change this"; test_tcp( client => sub { my $port = shift; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_SUB); $sock->connect("tcp://127.0.0.1:$port" ); $sock->setsockopt(ZMQ_SUBSCRIBE, ''); my $data = join '.', time(), $$, rand, {}; my $msg; for my $cnt ( 0.. ( $max - 1 ) ) { $msg = $sock->recv(); my $data = $msg->data; is($data, $cnt, "Expected $cnt, got $data"); } $msg = $sock->recv(); is( $msg->data, "end", "Done!" ); note "Received all messages"; }, server => sub { my $port = shift; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_PUB); note "Server Binding to port $port\n"; $sock->bind("tcp://127.0.0.1:$port"); note "Waiting on client to bind..."; sleep 2; note "Server sending ordered data... (numbers 1..1000)"; for my $c ( 0 .. ( $max - 1 ) ) { $sock->send($c, ZMQ_SNDMORE); } $sock->send("end"); # end of data stream... note "Sent all messages"; exit 0; } ); done_testing; ZeroMQ-0.23/xt/rt64836_lowlevel.t000644 000765 000024 00000003063 12037235040 017172 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::Requires qw( Test::TCP ); use Data::Dumper; BEGIN { use_ok "ZeroMQ::Raw"; use_ok "ZeroMQ::Constants", ":all"; } my $max = $ENV{ MSGCOUNT } || 100; note "Using $max messages to test - set MSGCOUNT to a different number if you want to change this"; test_tcp( client => sub { my $port = shift; my $ctxt = zmq_init(); my $sock = zmq_socket($ctxt, ZMQ_SUB); note "Client connecting to port $port"; zmq_connect($sock,"tcp://127.0.0.1:$port" ); zmq_setsockopt($sock, ZMQ_SUBSCRIBE, ''); note "Starting to receive data"; for my $cnt ( 0 .. ($max - 1) ) { my $rawmsg = zmq_recv($sock); my $data = zmq_msg_data($rawmsg); is($data, $cnt, "Expected $cnt, got $data"); } my $msg = zmq_recv( $sock ); is( zmq_msg_data($msg), "end", "Done!" ); note "Received all messages"; }, server => sub { my $port = shift; my $ctxt = zmq_init(); my $sock = zmq_socket($ctxt, ZMQ_PUB); note "Server Binding to port $port\n"; zmq_bind($sock, "tcp://127.0.0.1:$port"); note "Waiting on client to bind..."; sleep 2; note "Server sending ordered data... (numbers 1..1000)"; for my $c ( 0 .. ( $max - 1 ) ) { my $msg = zmq_msg_init_data($c); zmq_send($sock, $msg, ZMQ_SNDMORE); } zmq_send( $sock, "end" ); note "Sent all messages"; note "Server exiting..."; exit 0; } ); done_testing; ZeroMQ-0.23/xt/rt64944.t000644 000765 000024 00000000277 12037235040 015265 0ustar00daisukestaff000000 000000 use strict; use Test::More; BEGIN { if (! $ENV{TEST_LEAK}) { plan skip_all => "Set TEST_LEAK to run leak tests"; } } use Test::Requires 'Test::Valgrind'; do 't/rt64944.t'; ZeroMQ-0.23/xs/perl_zeromq.h000644 000765 000024 00000002271 12037235040 016543 0ustar00daisukestaff000000 000000 #ifndef __PERL_ZEROMQ_H__ #define __PERL_ZEROMQ_H__ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #include #include #ifndef PERLZMQ_TRACE #define PERLZMQ_TRACE 0 #endif #define _ERRNO errno #define SET_BANG PerlZMQ_set_bang(aTHX_ _ERRNO) inline void PerlZQM_set_bang(pTHX_ int err); #ifndef USE_ITHREADS typedef void PerlZMQ_Raw_Context; #else typedef struct { #ifdef tTHX /* tTHX doesn't exist in older perls */ tTHX interp; #else PerlInterpreter *interp; #endif void *ctxt; } PerlZMQ_Raw_Context; #endif typedef struct { void *socket; SV *assoc_ctxt; /* keep context around with sockets so we know */ } PerlZMQ_Raw_Socket; typedef zmq_msg_t PerlZMQ_Raw_Message; typedef struct { int bucket_size; int item_count; zmq_pollitem_t **items; char **item_ids; SV **callbacks; } PerlZMQ_PollItem; /* ZMQ_PULL was introduced for version 3, but it exists in git head. * it's just rename of ZMQ_UPSTREAM and ZMQ_DOWNSTREAM so we just * fake it here */ #ifndef ZMQ_PULL #define ZMQ_PULL ZMQ_UPSTREAM #endif #ifndef ZMQ_PUSH #define ZMQ_PUSH ZMQ_DOWNSTREAM #endif #endif /* __PERL_ZERMQ_H__ */ZeroMQ-0.23/xs/perl_zeromq.xs000644 000765 000024 00000054663 12037235040 016762 0ustar00daisukestaff000000 000000 #include "perl_zeromq.h" #include "xshelper.h" #if (PERLZMQ_TRACE > 0) #define PerlZMQ_trace(...) \ { \ PerlIO_printf(PerlIO_stderr(), "[perlzmq] "); \ PerlIO_printf(PerlIO_stderr(), __VA_ARGS__); \ PerlIO_printf(PerlIO_stderr(), "\n"); \ } #else #define PerlZMQ_trace(...) #endif STATIC_INLINE void PerlZMQ_set_bang(pTHX_ int err) { SV *errsv = get_sv("!", GV_ADD); PerlZMQ_trace("Set ERRSV ($!) to %d", err); sv_setiv(errsv, err); } STATIC_INLINE int PerlZMQ_Raw_Message_mg_dup(pTHX_ MAGIC* const mg, CLONE_PARAMS* const param) { PerlZMQ_Raw_Message *const src = (PerlZMQ_Raw_Message *) mg->mg_ptr; PerlZMQ_Raw_Message *dest; PerlZMQ_trace("Message -> dup"); PERL_UNUSED_VAR( param ); Newxz( dest, 1, PerlZMQ_Raw_Message ); zmq_msg_init( dest ); zmq_msg_copy ( dest, src ); mg->mg_ptr = (char *) dest; return 0; } STATIC_INLINE int PerlZMQ_Raw_Message_mg_free( pTHX_ SV * const sv, MAGIC *const mg ) { PerlZMQ_Raw_Message* const msg = (PerlZMQ_Raw_Message *) mg->mg_ptr; PERL_UNUSED_VAR(sv); PerlZMQ_trace( "START mg_free (Message)" ); if ( msg != NULL ) { PerlZMQ_trace( " + zmq message %p", msg ); zmq_msg_close( msg ); Safefree( msg ); } PerlZMQ_trace( "END mg_free (Message)" ); return 1; } STATIC_INLINE MAGIC* PerlZMQ_Raw_Message_mg_find(pTHX_ SV* const sv, const MGVTBL* const vtbl){ MAGIC* mg; assert(sv != NULL); assert(vtbl != NULL); for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){ if(mg->mg_virtual == vtbl){ assert(mg->mg_type == PERL_MAGIC_ext); return mg; } } croak("ZeroMQ::Raw::Message: Invalid ZeroMQ::Raw::Message object was passed to mg_find"); return NULL; /* not reached */ } STATIC_INLINE int PerlZMQ_Raw_Context_mg_free( pTHX_ SV * const sv, MAGIC *const mg ) { PerlZMQ_Raw_Context* const ctxt = (PerlZMQ_Raw_Context *) mg->mg_ptr; PERL_UNUSED_VAR(sv); PerlZMQ_trace("START mg_free (Context)"); if (ctxt != NULL) { #ifdef USE_ITHREADS PerlZMQ_trace( " + thread enabled. thread %p", aTHX ); PerlZMQ_trace( " + context wrapper %p with zmq context %p", ctxt, ctxt->ctxt ); if ( ctxt->interp == aTHX ) { /* is where I came from */ PerlZMQ_trace( " + detected mg_free from creating thread %p, cleaning up", aTHX ); zmq_term( ctxt->ctxt ); mg->mg_ptr = NULL; Safefree(ctxt); } #else PerlZMQ_trace(" + zmq context %p", ctxt); zmq_term( ctxt ); mg->mg_ptr = NULL; #endif } PerlZMQ_trace("END mg_free (Context)"); return 1; } STATIC_INLINE MAGIC* PerlZMQ_Raw_Context_mg_find(pTHX_ SV* const sv, const MGVTBL* const vtbl){ MAGIC* mg; assert(sv != NULL); assert(vtbl != NULL); for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){ if(mg->mg_virtual == vtbl){ assert(mg->mg_type == PERL_MAGIC_ext); return mg; } } croak("ZeroMQ::Raw::Context: Invalid ZeroMQ::Raw::Context object was passed to mg_find"); return NULL; /* not reached */ } STATIC_INLINE int PerlZMQ_Raw_Context_mg_dup(pTHX_ MAGIC* const mg, CLONE_PARAMS* const param){ PERL_UNUSED_VAR(mg); PERL_UNUSED_VAR(param); return 0; } STATIC_INLINE int PerlZMQ_Raw_Socket_invalidate( PerlZMQ_Raw_Socket *sock ) { SV *ctxt_sv = sock->assoc_ctxt; int rv; PerlZMQ_trace("START socket_invalidate"); PerlZMQ_trace(" + zmq socket %p", sock->socket); rv = zmq_close( sock->socket ); if ( SvOK(ctxt_sv) ) { PerlZMQ_trace(" + associated context: %p", ctxt_sv); SvREFCNT_dec(ctxt_sv); sock->assoc_ctxt = NULL; } Safefree(sock); PerlZMQ_trace("END socket_invalidate"); return rv; } STATIC_INLINE int PerlZMQ_Raw_Socket_mg_free(pTHX_ SV* const sv, MAGIC* const mg) { PerlZMQ_Raw_Socket* const sock = (PerlZMQ_Raw_Socket *) mg->mg_ptr; PERL_UNUSED_VAR(sv); PerlZMQ_trace("START mg_free (Socket)"); if (sock) { PerlZMQ_Raw_Socket_invalidate( sock ); mg->mg_ptr = NULL; } PerlZMQ_trace("END mg_free (Socket)"); return 1; } STATIC_INLINE int PerlZMQ_Raw_Socket_mg_dup(pTHX_ MAGIC* const mg, CLONE_PARAMS* const param){ #ifdef USE_ITHREADS /* single threaded perl has no "xxx_dup()" APIs */ mg->mg_ptr = NULL; PERL_UNUSED_VAR(param); #else PERL_UNUSED_VAR(mg); PERL_UNUSED_VAR(param); #endif return 0; } STATIC_INLINE MAGIC* PerlZMQ_Raw_Socket_mg_find(pTHX_ SV* const sv, const MGVTBL* const vtbl){ MAGIC* mg; assert(sv != NULL); assert(vtbl != NULL); for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic){ if(mg->mg_virtual == vtbl){ assert(mg->mg_type == PERL_MAGIC_ext); return mg; } } croak("ZeroMQ::Socket: Invalid ZeroMQ::Socket object was passed to mg_find"); return NULL; /* not reached */ } STATIC_INLINE void PerlZMQ_free_string(void *data, void *hint) { PERL_UNUSED_ARG(hint); free(data); } #include "mg-xs.inc" MODULE = ZeroMQ PACKAGE = ZeroMQ PREFIX = PerlZMQ_ PROTOTYPES: DISABLED BOOT: { PerlZMQ_trace( "Booting Perl ZeroMQ" ); } void PerlZMQ_version() PREINIT: int major, minor, patch; I32 gimme; PPCODE: gimme = GIMME_V; if (gimme == G_VOID) { /* WTF? you don't want a return value?! */ XSRETURN(0); } zmq_version(&major, &minor, &patch); if (gimme == G_SCALAR) { XPUSHs( sv_2mortal( newSVpvf( "%d.%d.%d", major, minor, patch ) ) ); XSRETURN(1); } else { mXPUSHi( major ); mXPUSHi( minor ); mXPUSHi( patch ); XSRETURN(3); } MODULE = ZeroMQ PACKAGE = ZeroMQ::Constants INCLUDE: const-xs.inc MODULE = ZeroMQ PACKAGE = ZeroMQ::Raw PREFIX = PerlZMQ_Raw_ PROTOTYPES: DISABLED PerlZMQ_Raw_Context * PerlZMQ_Raw_zmq_init( nthreads = 5 ) int nthreads; PREINIT: SV *class_sv = sv_2mortal(newSVpvn( "ZeroMQ::Raw::Context", 20 )); CODE: PerlZMQ_trace( "START zmq_init" ); #ifdef USE_ITHREADS PerlZMQ_trace( " + threads enabled, aTHX %p", aTHX ); Newxz( RETVAL, 1, PerlZMQ_Raw_Context ); RETVAL->interp = aTHX; RETVAL->ctxt = zmq_init( nthreads ); PerlZMQ_trace( " + created context wrapper %p", RETVAL ); PerlZMQ_trace( " + zmq context %p", RETVAL->ctxt ); #else PerlZMQ_trace( " + non-threaded context"); RETVAL = zmq_init( nthreads ); #endif PerlZMQ_trace( "END zmq_init"); OUTPUT: RETVAL int PerlZMQ_Raw_zmq_term( context ) PerlZMQ_Raw_Context *context; CODE: #ifdef USE_ITHREADS RETVAL = zmq_term( context->ctxt ); #else RETVAL = zmq_term( context ); #endif if (RETVAL == 0) { /* Cancel the SV's mg attr so to not call zmq_term automatically */ MAGIC *mg = PerlZMQ_Raw_Context_mg_find( aTHX_ SvRV(ST(0)), &PerlZMQ_Raw_Context_vtbl ); mg->mg_ptr = NULL; } /* mark the original SV's _closed flag as true */ { SV *svr = SvRV(ST(0)); if (hv_stores( (HV *) svr, "_closed", &PL_sv_yes ) == NULL) { croak("PANIC: Failed to store closed flag on blessed reference"); } } OUTPUT: RETVAL PerlZMQ_Raw_Message * PerlZMQ_Raw_zmq_msg_init() PREINIT: SV *class_sv = sv_2mortal(newSVpvn( "ZeroMQ::Raw::Message", 20 )); int rc; CODE: Newxz( RETVAL, 1, PerlZMQ_Raw_Message ); rc = zmq_msg_init( RETVAL ); if ( rc != 0 ) { SET_BANG; zmq_msg_close( RETVAL ); RETVAL = NULL; } OUTPUT: RETVAL PerlZMQ_Raw_Message * PerlZMQ_Raw_zmq_msg_init_size( size ) IV size; PREINIT: SV *class_sv = sv_2mortal(newSVpvn( "ZeroMQ::Raw::Message", 20 )); int rc; CODE: Newxz( RETVAL, 1, PerlZMQ_Raw_Message ); rc = zmq_msg_init_size(RETVAL, size); if ( rc != 0 ) { SET_BANG; zmq_msg_close( RETVAL ); RETVAL = NULL; } OUTPUT: RETVAL PerlZMQ_Raw_Message * PerlZMQ_Raw_zmq_msg_init_data( data, size = -1) SV *data; IV size; PREINIT: SV *class_sv = sv_2mortal(newSVpvn( "ZeroMQ::Raw::Message", 20 )); STRLEN x_data_len; char *sv_data = SvPV(data, x_data_len); char *x_data; int rc; CODE: if (size >= 0) { x_data_len = size; } Newxz( RETVAL, 1, PerlZMQ_Raw_Message ); x_data = (char *)malloc(x_data_len); memcpy(x_data, sv_data, x_data_len); rc = zmq_msg_init_data(RETVAL, x_data, x_data_len, PerlZMQ_free_string, NULL); if ( rc != 0 ) { SET_BANG; zmq_msg_close( RETVAL ); RETVAL = NULL; } else { PerlZMQ_trace("zmq_msg_init_data created message %p", RETVAL); } OUTPUT: RETVAL SV * PerlZMQ_Raw_zmq_msg_data(message) PerlZMQ_Raw_Message *message; CODE: RETVAL = newSV(0); sv_setpvn( RETVAL, (char *) zmq_msg_data(message), (STRLEN) zmq_msg_size(message) ); OUTPUT: RETVAL size_t PerlZMQ_Raw_zmq_msg_size(message) PerlZMQ_Raw_Message *message; CODE: RETVAL = zmq_msg_size(message); OUTPUT: RETVAL int PerlZMQ_Raw_zmq_msg_close(message) PerlZMQ_Raw_Message *message; CODE: PerlZMQ_trace("START zmq_msg_close"); RETVAL = zmq_msg_close(message); Safefree(message); { MAGIC *mg = PerlZMQ_Raw_Message_mg_find( aTHX_ SvRV(ST(0)), &PerlZMQ_Raw_Message_vtbl ); mg->mg_ptr = NULL; } /* mark the original SV's _closed flag as true */ { SV *svr = SvRV(ST(0)); if (hv_stores( (HV *) svr, "_closed", &PL_sv_yes ) == NULL) { croak("PANIC: Failed to store closed flag on blessed reference"); } } PerlZMQ_trace("END zmq_msg_close"); OUTPUT: RETVAL int PerlZMQ_Raw_zmq_msg_move(dest, src) PerlZMQ_Raw_Message *dest; PerlZMQ_Raw_Message *src; CODE: RETVAL = zmq_msg_move( dest, src ); OUTPUT: RETVAL int PerlZMQ_Raw_zmq_msg_copy (dest, src); PerlZMQ_Raw_Message *dest; PerlZMQ_Raw_Message *src; CODE: RETVAL = zmq_msg_copy( dest, src ); OUTPUT: RETVAL PerlZMQ_Raw_Socket * PerlZMQ_Raw_zmq_socket (ctxt, type) PerlZMQ_Raw_Context *ctxt; IV type; PREINIT: SV *class_sv = sv_2mortal(newSVpvn( "ZeroMQ::Raw::Socket", 19 )); CODE: PerlZMQ_trace( "START zmq_socket" ); Newxz( RETVAL, 1, PerlZMQ_Raw_Socket ); RETVAL->assoc_ctxt = NULL; RETVAL->socket = NULL; #ifdef USE_ITHREADS PerlZMQ_trace( " + context wrapper %p, zmq context %p", ctxt, ctxt->ctxt ); RETVAL->socket = zmq_socket( ctxt->ctxt, type ); #else PerlZMQ_trace( " + zmq context %p", ctxt ); RETVAL->socket = zmq_socket( ctxt, type ); #endif RETVAL->assoc_ctxt = ST(0); SvREFCNT_inc(RETVAL->assoc_ctxt); PerlZMQ_trace( " + created socket %p", RETVAL ); PerlZMQ_trace( "END zmq_socket" ); OUTPUT: RETVAL int PerlZMQ_Raw_zmq_close(socket) PerlZMQ_Raw_Socket *socket; CODE: RETVAL = PerlZMQ_Raw_Socket_invalidate( socket ); /* Cancel the SV's mg attr so to not call socket_invalidate again during Socket_mg_free */ { MAGIC *mg = PerlZMQ_Raw_Socket_mg_find( aTHX_ SvRV(ST(0)), &PerlZMQ_Raw_Socket_vtbl ); mg->mg_ptr = NULL; } /* mark the original SV's _closed flag as true */ { SV *svr = SvRV(ST(0)); if (hv_stores( (HV *) svr, "_closed", &PL_sv_yes ) == NULL) { croak("PANIC: Failed to store closed flag on blessed reference"); } } OUTPUT: RETVAL int PerlZMQ_Raw_zmq_connect(socket, addr) PerlZMQ_Raw_Socket *socket; char *addr; CODE: PerlZMQ_trace( "START zmq_connect" ); PerlZMQ_trace( " + socket %p", socket ); RETVAL = zmq_connect( socket->socket, addr ); if (RETVAL != 0) { croak( "%s", zmq_strerror( zmq_errno() ) ); } PerlZMQ_trace( "END zmq_connect" ); OUTPUT: RETVAL int PerlZMQ_Raw_zmq_bind(socket, addr) PerlZMQ_Raw_Socket *socket; char *addr; CODE: PerlZMQ_trace( "zmq_bind: socket %p", socket ); RETVAL = zmq_bind( socket->socket, addr ); if (RETVAL != 0) { croak( "%s", zmq_strerror( zmq_errno() ) ); } OUTPUT: RETVAL PerlZMQ_Raw_Message * PerlZMQ_Raw_zmq_recv(socket, flags = 0) PerlZMQ_Raw_Socket *socket; int flags; PREINIT: SV *class_sv = sv_2mortal(newSVpvn( "ZeroMQ::Raw::Message", 20 )); int rv; zmq_msg_t msg; CODE: PerlZMQ_trace( "START zmq_recv" ); RETVAL = NULL; zmq_msg_init(&msg); rv = zmq_recv(socket->socket, &msg, flags); PerlZMQ_trace(" + zmq recv with flags %d", flags); PerlZMQ_trace(" + zmq_recv returned with rv '%d'", rv); if (rv != 0) { SET_BANG; zmq_msg_close(&msg); PerlZMQ_trace(" + zmq_recv got bad status, closing temporary message"); } else { Newxz(RETVAL, 1, PerlZMQ_Raw_Message); zmq_msg_init(RETVAL); zmq_msg_copy( RETVAL, &msg ); zmq_msg_close(&msg); PerlZMQ_trace(" + zmq_recv created message %p", RETVAL ); } OUTPUT: RETVAL int PerlZMQ_Raw_zmq_send(socket, message, flags = 0) PerlZMQ_Raw_Socket *socket; SV *message; int flags; PREINIT: PerlZMQ_Raw_Message *msg = NULL; CODE: if (! SvOK(message)) croak("ZeroMQ::Socket::send() NULL message passed"); if (sv_isobject(message) && sv_isa(message, "ZeroMQ::Raw::Message")) { MAGIC *mg = PerlZMQ_Raw_Context_mg_find(aTHX_ SvRV(message), &PerlZMQ_Raw_Message_vtbl); if (mg) { msg = (PerlZMQ_Raw_Message *) mg->mg_ptr; } if (msg == NULL) { croak("Got invalid message object"); } RETVAL = zmq_send(socket->socket, msg, flags); } else { STRLEN data_len; char *x_data; char *data = SvPV(message, data_len); zmq_msg_t msg; x_data = (char *)malloc(data_len); memcpy(x_data, data, data_len); zmq_msg_init_data(&msg, x_data, data_len, PerlZMQ_free_string, NULL); RETVAL = zmq_send(socket->socket, &msg, flags); zmq_msg_close( &msg ); } OUTPUT: RETVAL SV * PerlZMQ_Raw_zmq_getsockopt(sock, option) PerlZMQ_Raw_Socket *sock; int option; PREINIT: char buf[256]; int i; uint64_t u64; int64_t i64; uint32_t i32; size_t len; int status = -1; CODE: switch(option){ case ZMQ_TYPE: case ZMQ_LINGER: #ifdef ZMQ_RECONNECT_IVL case ZMQ_RECONNECT_IVL: #endif #ifdef ZMQ_RECONNECT_IVL_MAX case ZMQ_RECONNECT_IVL_MAX: #endif case ZMQ_BACKLOG: case ZMQ_FD: len = sizeof(i); status = zmq_getsockopt(sock->socket, option, &i, &len); if(status == 0) RETVAL = newSViv(i); break; case ZMQ_RCVMORE: case ZMQ_SWAP: case ZMQ_RATE: case ZMQ_RECOVERY_IVL: case ZMQ_MCAST_LOOP: len = sizeof(i64); status = zmq_getsockopt(sock->socket, option, &i64, &len); if(status == 0) RETVAL = newSViv(i64); break; case ZMQ_HWM: case ZMQ_AFFINITY: case ZMQ_SNDBUF: case ZMQ_RCVBUF: len = sizeof(u64); status = zmq_getsockopt(sock->socket, option, &u64, &len); if(status == 0) RETVAL = newSVuv(u64); break; case ZMQ_EVENTS: len = sizeof(i32); status = zmq_getsockopt(sock->socket, option, &i32, &len); if(status == 0) RETVAL = newSViv(i32); break; case ZMQ_IDENTITY: len = sizeof(buf); status = zmq_getsockopt(sock->socket, option, &buf, &len); if(status == 0) RETVAL = newSVpvn(buf, len); break; } if(status != 0){ switch(_ERRNO) { SET_BANG; case EINTR: croak("The operation was interrupted by delivery of a signal"); case ETERM: croak("The 0MQ context accociated with the specified socket was terminated"); case EFAULT: croak("The provided socket was not valid"); case EINVAL: croak("Invalid argument"); default: croak("Unknown error reading socket option"); } } OUTPUT: RETVAL int PerlZMQ_Raw_zmq_setsockopt(sock, option, value) PerlZMQ_Raw_Socket *sock; int option; SV *value; PREINIT: STRLEN len; const char *ptr; uint64_t u64; int64_t i64; int i; CODE: switch(option){ case ZMQ_IDENTITY: case ZMQ_SUBSCRIBE: case ZMQ_UNSUBSCRIBE: ptr = SvPV(value, len); RETVAL = zmq_setsockopt(sock->socket, option, ptr, len); break; case ZMQ_SWAP: case ZMQ_RATE: #ifdef ZMQ_RECONNECT_IVL case ZMQ_RECONNECT_IVL: #endif #ifdef ZMQ_RECONNECT_IVL_MAX case ZMQ_RECONNECT_IVL_MAX: #endif case ZMQ_MCAST_LOOP: i64 = SvIV(value); RETVAL = zmq_setsockopt(sock->socket, option, &i64, sizeof(int64_t)); break; case ZMQ_HWM: case ZMQ_AFFINITY: case ZMQ_SNDBUF: case ZMQ_RCVBUF: u64 = SvUV(value); RETVAL = zmq_setsockopt(sock->socket, option, &u64, sizeof(uint64_t)); break; case ZMQ_LINGER: i = SvIV(value); RETVAL = zmq_setsockopt(sock->socket, option, &i, sizeof(i)); break; default: warn("Unknown sockopt type %d, assuming string. Send patch", option); ptr = SvPV(value, len); RETVAL = zmq_setsockopt(sock->socket, option, ptr, len); } OUTPUT: RETVAL int PerlZMQ_Raw_zmq_poll( list, timeout = 0 ) AV *list; long timeout; PREINIT: I32 list_len; zmq_pollitem_t *pollitems; CV **callbacks; int i; CODE: list_len = av_len( list ) + 1; if (list_len <= 0) { XSRETURN(0); } Newxz( pollitems, list_len, zmq_pollitem_t); Newxz( callbacks, list_len, CV *); /* list should be a list of hashrefs fd, events, and callbacks */ for (i = 0; i < list_len; i++) { SV **svr = av_fetch( list, i, 0 ); HV *elm; if (svr == NULL || ! SvOK(*svr) || ! SvROK(*svr) || SvTYPE(SvRV(*svr)) != SVt_PVHV) { Safefree( pollitems ); Safefree( callbacks ); croak("Invalid value on index %d", i); } elm = (HV *) SvRV(*svr); callbacks[i] = NULL; pollitems[i].revents = 0; pollitems[i].events = 0; pollitems[i].fd = 0; pollitems[i].socket = NULL; svr = hv_fetch( elm, "socket", 6, NULL ); if (svr != NULL) { MAGIC *mg; if (! SvOK(*svr) || !sv_isobject( *svr) || ! sv_isa(*svr, "ZeroMQ::Raw::Socket")) { Safefree( pollitems ); Safefree( callbacks ); croak("Invalid 'socket' given for index %d", i); } mg = PerlZMQ_Raw_Socket_mg_find( aTHX_ SvRV(*svr), &PerlZMQ_Raw_Socket_vtbl ); pollitems[i].socket = ((PerlZMQ_Raw_Socket *) mg->mg_ptr)->socket; PerlZMQ_trace( " + pollitem[%d].socket = %p", i, pollitems[i].socket ); } else { svr = hv_fetch( elm, "fd", 2, NULL ); if (svr == NULL || ! SvOK(*svr) || SvTYPE(*svr) != SVt_IV) { Safefree( pollitems ); Safefree( callbacks ); croak("Invalid 'fd' given for index %d", i); } pollitems[i].fd = SvIV( *svr ); } svr = hv_fetch( elm, "events", 6, NULL ); if (svr == NULL || ! SvOK(*svr) || SvTYPE(*svr) != SVt_IV) { Safefree( pollitems ); Safefree( callbacks ); croak("Invalid 'events' given for index %d", i); } pollitems[i].events = SvIV( *svr ); svr = hv_fetch( elm, "callback", 8, NULL ); if (svr == NULL || ! SvOK(*svr) || ! SvROK(*svr) || SvTYPE(SvRV(*svr)) != SVt_PVCV) { Safefree( pollitems ); Safefree( callbacks ); croak("Invalid 'callback' given for index %d", i); } callbacks[i] = (CV *) SvRV( *svr ); } /* now call zmq_poll */ RETVAL = zmq_poll( pollitems, list_len, timeout ); for ( i = 0; i < list_len; i++ ) { if (pollitems[i].revents & pollitems[i].events) { dSP; ENTER; SAVETMPS; PUSHMARK(SP); PUTBACK; call_sv( (SV*)callbacks[i], G_SCALAR ); SPAGAIN; PUTBACK; FREETMPS; LEAVE; } } Safefree(pollitems); Safefree(callbacks); OUTPUT: RETVAL int PerlZMQ_Raw_zmq_device( device, insocket, outsocket ) int device; PerlZMQ_Raw_Socket *insocket; PerlZMQ_Raw_Socket *outsocket; CODE: RETVAL = zmq_device( device, insocket->socket, outsocket->socket ); OUTPUT: RETVAL ZeroMQ-0.23/tools/check_mi_mods.pl000644 000765 000024 00000002335 12037235040 017663 0ustar00daisukestaff000000 000000 # Okay, so some people wanting to check out the latest and greatest # version from github is getting stuck not knowing what M::I modules # to install. So do the check here my @modules = qw( inc::Module::Install Module::Install::AuthorTests Module::Install::CheckLib Module::Install::ReadmeFromPod Module::Install::TestTarget Module::Install::XSUtil Module::Install::Repository ); my @missing; foreach my $module (@modules) { eval "require $module"; push @missing, $module if $@; } if (@missing) { print STDERR <import; ZeroMQ-0.23/tools/detect_zmq.pl000644 000765 000024 00000006546 12037235040 017246 0ustar00daisukestaff000000 000000 #!/usr/bin/env perl use strict; use File::Spec; # probe env vars first, as you may have wanted to override # any auto-discoverable values probe_envvars(); probe_pkgconfig(); sub probe_envvars { print "Probing environment variables:\n"; my $home = $ENV{ZMQ_HOME}; if (! $ENV{ZMQ_INCLUDES}) { my @incpaths; if ($ENV{INCLUDES}) { print " + Detected ZMQ_INCLUDES from INCLUDES (deprecated)...\n"; push @incpaths, $ENV{INCLUDES}; } if ($home) { my $zmq_inc = File::Spec->catdir( $home, 'include' ); if (-e $zmq_inc) { print " + Detected ZMQ_INCLUDES from ZMQ_HOME...\n"; push @incpaths, $zmq_inc; } } if (@incpaths) { $ENV{ZMQ_INCLUDES} = join ' ', @incpaths; } } if (! $ENV{ZMQ_H}) { if ($home) { my $zmq_header = File::Spec->catfile( $home, 'include', 'zmq.h' ); if ( -f $zmq_header ) { print " + Detected ZMQ_H from ZMQ_HOME...\n"; $ENV{ZMQ_H} = $zmq_header; } } } if (! $ENV{ZMQ_LIBS}) { my @libs; if ($ENV{LIBS}) { print " + Detected ZMQ_LIBS from LIBS (deprecated)...\n"; push @libs, $ENV{LIBS}; } if ($home) { my $zmq_lib = File::Spec->catdir( $home, 'lib' ); if (-e $zmq_lib) { print " + Detected ZMQ_LIBS from ZMQ_HOME...\n"; push @libs, sprintf '-L%s', $zmq_lib; } } if (@libs) { $ENV{ZMQ_LIBS} = join ' ', @libs; } } } # Note: At this point probe_envvars should have taken care merging # deprecated INCLUDES/LIBS into %ENV sub probe_pkgconfig { my $pkg_config = $ENV{ PKGCONFIG_CMD } || 'pkg-config'; foreach my $pkg ( qw(libzmq zeromq2) ) { print "Probing $pkg via $pkg_config ...\n"; my $version = qx/$pkg_config --modversion $pkg/; chomp $version; if (! $version) { print " - No $pkg found...\n"; next; } print " + found $pkg $version\n"; my ($major, $minor, $micro) = split /\./, $version; if ( $major != 2 && $minor != 1 ) { die "Whoa there! We don't support anything other than libzmq 2.1.x"; } if (! $ENV{ZMQ_INCLUDES}) { if (my $cflags = qx/$pkg_config --cflags-only-I $pkg/) { chomp $cflags; print " + Detected ZMQ_INCLUDES from $pkg_config...\n"; my @paths = map { s/^-I//; $_ } split /\s+/, $cflags; $ENV{ZMQ_INCLUDES} = join ' ', @paths; if (! $ENV{ZMQ_H}) { foreach my $path (@paths) { my $zmq_h = File::Spec->catfile($path, 'zmq.h'); if (-f $zmq_h) { print " + Detected ZMQ_H from $pkg_config...\n"; $ENV{ZMQ_H} = $zmq_h; last; } } } } } if (! $ENV{ZMQ_LIBS}) { if (my $libs = qx/$pkg_config --libs $pkg/) { chomp $libs; print " + Detected ZMQ_LIBS from $pkg_config...\n"; $ENV{ZMQ_LIBS} = $libs; } } last; } }ZeroMQ-0.23/tools/genfiles.pl000644 000765 000024 00000014231 12037235040 016671 0ustar00daisukestaff000000 000000 use strict; use Config; use File::Spec; use File::Basename qw(dirname); use List::Util qw(first); write_constants_file( File::Spec->catfile('xs', 'const-xs.inc') ); write_typemap( File::Spec->catfile('xs', 'typemap') ); write_magic_file( File::Spec->catfile('xs', 'mg-xs.inc') ); sub write_magic_file { my $file = shift; open my $fh, '>', $file or die "Could not open objects file $file: $!"; print $fh <mg_ptr); return 0; } STATIC_INLINE int PerlZMQ_mg_dup(pTHX_ MAGIC* const mg, CLONE_PARAMS* const param) { PERL_UNUSED_VAR(mg); PERL_UNUSED_VAR(param); return 0; } EOM open my $src, '<', "xs/perl_zeromq.xs"; my @perl_types = qw( ZeroMQ::Raw::Context ZeroMQ::Raw::Socket ZeroMQ::Raw::Message ); foreach my $perl_type (@perl_types) { my $c_type = $perl_type; $c_type =~ s/::/_/g; $c_type =~ s/^ZeroMQ/PerlZMQ/; my $vtablename = sprintf '%s_vtbl', $c_type; # check if we have a function named ${c_type}_free and ${c_type}_mg_dup my ($has_free, $has_dup); seek ($src, 0, 0); while (<$src>) { $has_free++ if /^${c_type}_mg_free\b/; $has_dup++ if /^${c_type}_mg_dup\b/; } my $free = $has_free ? "${c_type}_mg_free" : "PerlZMQ_mg_free"; my $dup = $has_dup ? "${c_type}_mg_dup" : "PerlZMQ_mg_dup"; print $fh <catfile( $_, 'include', 'zmq.h' ) } ('/usr/local', '/usr', File::Spec->catdir( dirname($Config{perlpath}), File::Spec->updir ) ) ); if (! $header) { die "Could not find zmq.h anywhere."; } print STDERR " + Using zmq.h from $header\n"; open( my $in, '<', $header ) or die "Could not open file $header for reading: $!"; open( my $out, '>', $file ) or die "Could not open file $file for writing: $!"; print $out "# Do NOT edit this file! This file was automatically generated\n", "# by Makefile.PL on @{[scalar localtime]}. If you want to\n", "# regenerate it, remove this file and re-run Makefile.PL\n", "\n", "IV\n", "_constant()\n", " ALIAS:\n", ; while (my $ln = <$in>) { if ($ln =~ /^\#define\s+(ZMQ_[A-Z0-9_]+)\s+/) { print $out " $1 = $1\n"; } } close $in; print $out " CODE:\n", " RETVAL = ix;\n", " OUTPUT:\n", " RETVAL\n" ; close $out; } sub write_typemap { my $file = shift; my @perl_types = qw( ZeroMQ::Raw::Context ZeroMQ::Raw::Socket ZeroMQ::Raw::Message ); open( my $out, '>', $file ) or die "Could not open $file for writing: $!"; my (@decl, @input, @output); foreach my $perl_type (@perl_types) { my $c_type = $perl_type; $c_type =~ s/::/_/g; $c_type =~ s/^ZeroMQ_/PerlZMQ_/; my $typemap_type = 'T_' . uc $c_type; push @decl, "$c_type* $typemap_type"; push @input, <mg_ptr; } if (\$var == NULL) croak(\\"Invalid $perl_type object (perhaps you've already freed it?)\\"); } EOM push @output, <mg_flags |= MGf_DUP; } EOM } print $out "# Do NOT edit this file! This file was automatically generated\n", "# by Makefile.PL on @{[scalar localtime]}. If you want to\n", "# regenerate it, remove this file and re-run Makefile.PL\n", "\n" ; print $out join( "\n", "TYPEMAP\n", join("\n", @decl), "\n", "INPUT\n", join("\n", @input), "\n", "OUTPUT\n", join("\n", @output), "\n", ); close $out; } ZeroMQ-0.23/t/000_compile.t000644 000765 000024 00000001364 12037235040 016042 0ustar00daisukestaff000000 000000 use strict; use Test::More; use_ok "ZeroMQ"; my ($major, $minor, $patch) = ZeroMQ::version(); my $version = join('.', $major, $minor, $patch); my $warning = sprintf(<recv() does not terminate even when a signal is sent (in such cases you need to resort to using SIGKILL). You should really be thinking about upgrading your libzmq to 2.1 or higher, and recompile ZeroMQ.pm against the new library. *************** EOM diag sprintf( "\n This is ZeroMQ.pm version %s\n Linked against zeromq2 %s\n%s", $ZeroMQ::VERSION, $version, ($major + $minor / 10) < 2.1 ? $warning : '' ); done_testing; ZeroMQ-0.23/t/001_context.t000644 000765 000024 00000001027 12037235040 016073 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::Fatal; BEGIN { use_ok "ZeroMQ::Raw", qw( zmq_init zmq_term ); } subtest 'sane creation/destroy' => sub { is exception { my $context = zmq_init(5); isa_ok $context, "ZeroMQ::Raw::Context"; zmq_term( $context ); }, undef, "sane allocation / cleanup for context"; is exception { my $context = zmq_init(); zmq_term( $context ); zmq_term( $context ); }, undef, "double zmq_term should not die"; }; done_testing;ZeroMQ-0.23/t/002_socket.t000644 000765 000024 00000005675 12037235040 015715 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::Fatal; BEGIN { use_ok "ZeroMQ::Constants", qw( ZMQ_PUSH ZMQ_REP ZMQ_REQ ); use_ok "ZeroMQ::Raw", qw( zmq_connect zmq_close zmq_init zmq_socket zmq_close ); } subtest 'simple creation and destroy' => sub { is exception { my $context = zmq_init(1); my $socket = zmq_socket( $context, ZMQ_REP ); isa_ok $socket, "ZeroMQ::Raw::Socket"; }, undef, "socket creation OK"; is exception { my $context = zmq_init(1); my $socket = zmq_socket( $context, ZMQ_REP ); isa_ok $socket, "ZeroMQ::Raw::Socket"; zmq_close( $socket ); }, undef, "socket create, then zmq_close"; is exception { my $context = zmq_init(); my $socket = zmq_socket( $context, ZMQ_REP ); zmq_close( $socket ); zmq_close( $socket ); }, undef, "double zmq_close should not die"; }; subtest 'connect to a non-existent addr' => sub { is exception { my $context = zmq_init(1); my $socket = zmq_socket( $context, ZMQ_PUSH ); TODO: { todo_skip "I get 'Assertion failed: rc == 0 (zmq_connecter.cpp:46)'", 2; lives_ok { zmq_connect( $socket, "tcp://inmemory" ); } "connect should succeed"; zmq_close( $socket ); dies_ok { zmq_connect( $socket, "tcp://inmemory" ); } "connect should fail on a closed socket"; } }, undef, "check for proper handling of closed socket"; }; subtest 'github pull 33 (ZMQ_RECONNECT_IVL)' => sub { SKIP: { my $ok = ZeroMQ::Constants->can('ZMQ_RECONNECT_IVL') && ZeroMQ::Constants->can('ZMQ_RECONNECT_IVL_MAX') ; if (! $ok) { skip 1, "ZMQ_RECONNET_IVL(_MAX) not available"; } } is exception { my $ctx = ZeroMQ::Context->new; my $sock = $ctx->socket(ZMQ_PUSH); my %consts = ( ZMQ_RECONNCET_IVL => ZeroMQ::Constants::ZMQ_RECONNECT_IVL(), ZMQ_RECONNCET_IVL_MAX => ZeroMQ::Constants::ZMQ_RECONNECT_IVL_MAX() ); while ( my ($name, $value) = each %consts ) { note "BEFORE: $name: " . $sock->getsockopt($value); $sock->setsockopt( $value, 500 ); note "AFTER: $name: " . $sock->getsockopt($value); } }, undef, "no exception"; }; done_testing; __END__ SKIP : { eval { ZeroMQ::ZMQ_FD }; skip "ZMQ_FD not available on this version: $@", 2 if $@; my $context = ZeroMQ::Context->new; my $socket = $context->socket(ZMQ_REP); $socket->bind("inproc://inmemory"); my $client = $context->socket(ZMQ_REQ); $client->connect("inproc://inmemory"); my $handle = $socket->getsockopt( ZeroMQ::ZMQ_FD ); ok $handle; isa_ok $handle, "IO::Handle"; $client->send("TEST"); my $buf; sysread $handle, $buf, 4192, 0; warn $buf; }; done_testing;ZeroMQ-0.23/t/003_message.t000644 000765 000024 00000003551 12037235040 016041 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::Fatal; BEGIN { use_ok "ZeroMQ::Raw", qw( zmq_msg_init zmq_msg_init_data zmq_msg_init_size zmq_msg_data zmq_msg_size zmq_msg_copy zmq_msg_move zmq_msg_close ); } subtest "sane allocation / cleanup for message" => sub { is exception { my $msg = ZeroMQ::Raw::zmq_msg_init(); isa_ok $msg, "ZeroMQ::Raw::Message"; is zmq_msg_data( $msg ), '', "no message data"; is zmq_msg_size( $msg ), 0, "data size is 0"; }, undef, "code lives"; is exception { my $msg = zmq_msg_init(); zmq_msg_close($msg); zmq_msg_close($msg); }, undef, "double close should not die"; }; subtest "sane allocation / cleanup for message (init_data)" => sub { is exception { my $data = "TESTTEST"; my $msg = zmq_msg_init_data( $data ); isa_ok $msg, "ZeroMQ::Raw::Message"; is zmq_msg_data( $msg ), $data, "data matches"; is zmq_msg_size( $msg ), length $data, "data size matches"; }, undef, "code lives"; }; subtest "sane allocation / cleanup for message (init_size)" => sub { is exception { my $msg = zmq_msg_init_size(100); isa_ok $msg, "ZeroMQ::Raw::Message"; # don't check data(), as it will be populated with garbage is zmq_msg_size( $msg ), 100, "data size is 100"; }, undef, "code lives"; }; subtest "copy / move" => sub { is exception { my $msg1 = zmq_msg_init_data( "foobar" ); my $msg2 = zmq_msg_init_data( "fogbaz" ); my $msg3 = zmq_msg_init_data( "figbun" ); is zmq_msg_copy( $msg1, $msg2 ), 0, "copy returns 0"; is zmq_msg_data( $msg1 ), zmq_msg_data( $msg2 ), "msg1 == msg2"; is zmq_msg_data( $msg1 ), "fogbaz", "... and msg2's data is in msg1"; }, undef, "code lives"; }; done_testing;ZeroMQ-0.23/t/004_version.t000644 000765 000024 00000000476 12037235040 016106 0ustar00daisukestaff000000 000000 use strict; use Test::More; use_ok "ZeroMQ"; { my $version = ZeroMQ::version(); ok $version; like $version, qr/^\d+\.\d+\.\d+$/, "dotted version string"; my ($major, $minor, $patch) = ZeroMQ::version(); is join('.', $major, $minor, $patch), $version, "list and scalar context"; } done_testing;ZeroMQ-0.23/t/005_poll.t000644 000765 000024 00000002272 12037235040 015364 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::Fatal; BEGIN { use_ok "ZeroMQ::Raw"; use_ok "ZeroMQ::Constants", ":all"; } subtest 'basic poll with fd' => sub { SKIP: { skip "Can't poll using fds on Windows", 2 if ($^O eq 'MSWin32'); is exception { my $called = 0; zmq_poll([ { fd => fileno(STDOUT), events => ZMQ_POLLOUT, callback => sub { $called++ } } ], 1); ok $called, "callback called"; }, undef, "PollItem doesn't die"; } }; subtest 'poll with zmq sockets' => sub { my $ctxt = zmq_init(); my $req = zmq_socket( $ctxt, ZMQ_REQ ); my $rep = zmq_socket( $ctxt, ZMQ_REP ); my $called = 0; is exception { zmq_bind( $rep, "inproc://polltest"); zmq_connect( $req, "inproc://polltest"); zmq_send( $req, "Test"); zmq_poll([ { socket => $rep, events => ZMQ_POLLIN, callback => sub { $called++ } }, ], 1); }, undef, "PollItem correctly handles callback"; is $called, 1; }; done_testing;ZeroMQ-0.23/t/006_anyevent.t000644 000765 000024 00000003175 12037235040 016253 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::Requires qw( Test::TCP AnyEvent ); BEGIN { use_ok "ZeroMQ::Raw"; use_ok "ZeroMQ::Constants", ":all"; } my $server = Test::TCP->new(code => sub { my $port = shift; my $ctxt = zmq_init(1); my $sock = zmq_socket( $ctxt, ZMQ_REP ); zmq_bind( $sock, "tcp://127.0.0.1:$port" ); my $msg; if ( $^O eq 'MSWin32' ) { note "Win32 server, using zmq_poll"; my $timeout = time() + 5; do { zmq_poll([ { socket => $sock, events => ZMQ_POLLIN, callback => sub { $msg = zmq_recv( $sock, ZMQ_RCVMORE ); } }, ], 5); } while (! $msg && time < $timeout ); } else { note "Using zmq_getsockopt + AE"; my $cv = AE::cv; note " + Extracting ZMQ_FD"; my $fh = zmq_getsockopt( $sock, ZMQ_FD ); note " + Creating AE::io for fd"; my $w; $w = AE::io $fh, 0, sub { if (my $msg = zmq_recv( $sock, ZMQ_RCVMORE )) { undef $w; $cv->send( $msg ); } }; note "Waiting..."; $msg = $cv->recv; } zmq_send( $sock, zmq_msg_data( $msg ) ); exit 0; }); my $port = $server->port; my $ctxt = zmq_init(1); my $sock = zmq_socket( $ctxt, ZMQ_REQ ); zmq_connect( $sock, "tcp://127.0.0.1:$port" ); my $data = join '.', time(), $$, rand, {}; note "Sending data to server"; zmq_send( $sock, $data ); my $msg = zmq_recv( $sock ); is $data, zmq_msg_data( $msg ), "Got back same data"; done_testing; ZeroMQ-0.23/t/100_basic.t000644 000765 000024 00000004575 12037235040 015503 0ustar00daisukestaff000000 000000 use strict; use warnings; use File::Spec; use Test::More; use ZeroMQ qw/:all/; use Storable qw/nfreeze thaw/; subtest 'connect before server socket is bound (should fail)' => sub { my $cxt = ZeroMQ::Context->new; my $sock = $cxt->socket(ZMQ_PAIR); # Receiver # too early, server socket not created: my $client = $cxt->socket(ZMQ_PAIR); eval { $client->connect("inproc://myPrivateSocket"); }; ok($@ && "$@" =~ /Connection refused/); }; subtest 'basic inproc communication' => sub { my $cxt = ZeroMQ::Context->new; my $sock = $cxt->socket(ZMQ_PAIR); # Receiver eval { $sock->bind("inproc://myPrivateSocket"); }; ok !$@, "bind to inproc socket"; my $client = $cxt->socket(ZMQ_PAIR); # sender eval { $client->connect("inproc://myPrivateSocket"); }; ok !$@, "connect to inproc socket"; ok(!defined($sock->recv(ZMQ_NOBLOCK())), "recv before sending anything should return nothing"); ok($client->send( ZeroMQ::Message->new("Talk to me") ) == 0); # These tests are potentially dangerous when upgrades happen.... # I thought of plain removing, but I'll leave it for now my ($major, $minor, $micro) = ZeroMQ::version(); SKIP: { skip( "Need to be exactly zeromq 2.1.0", 3 ) if ($major != 2 || $minor != 1 || $micro != 0); ok(!$sock->getsockopt(ZMQ_RCVMORE), "no ZMQ_RCVMORE set"); ok($sock->getsockopt(ZMQ_AFFINITY) == 0, "no ZMQ_AFFINITY"); ok($sock->getsockopt(ZMQ_RATE) == 100, "ZMQ_RATE is at default 100"); } my $msg = $sock->recv(); ok(defined $msg, "received defined msg"); is($msg->data, "Talk to me", "received correct message"); # now test with objects, just for kicks. my $obj = { foo => 'bar', baz => [1..9], blah => 'blubb', }; my $frozen = nfreeze($obj); ok($client->send( ZeroMQ::Message->new($frozen) ) == 0); $msg = $sock->recv(); ok(defined $msg, "received defined msg"); isa_ok($msg, 'ZeroMQ::Message'); is($msg->data(), $frozen, "got back same data"); my $robj = thaw($msg->data); is_deeply($robj, $obj); }; subtest 'invalid bind' => sub { my $cxt = ZeroMQ::Context->new(0); # must be 0 theads for in-process bind my $sock = $cxt->socket(ZMQ_REP); # server like reply socket eval {$sock->bind("bulls***");}; ok($@ && "$@" =~ /Invalid argument/); }; done_testing; ZeroMQ-0.23/t/101_threads.t000644 000765 000024 00000003036 12037235040 016044 0ustar00daisukestaff000000 000000 BEGIN { require Config; if (!$Config::Config{useithreads}) { print "1..0 # Skip: no ithreads\n"; exit 0; } } use strict; use warnings; use threads; use Test::More; use Test::Fatal; use ZeroMQ qw/:all/; { my $cxt = ZeroMQ::Context->new(1); isa_ok($cxt, 'ZeroMQ::Context'); my $main_socket = $cxt->socket(ZMQ_PUSH); isa_ok($main_socket, "ZeroMQ::Socket"); $main_socket->close; my $t = threads->new(sub { note "created thread " . threads->tid; my $sock = $cxt->socket( ZMQ_PAIR ); ok $sock, "created server socket"; is exception { $sock->bind("inproc://myPrivateSocket"); }, undef, "bound server socket"; my $client = $cxt->socket(ZMQ_PAIR); # sender ok $client, "created client socket"; is exception { $client->connect("inproc://myPrivateSocket"); }, undef, "connected client socket"; $client->send( "Wee Woo" ); my $data = $sock->recv(); my $ok = 0; if (ok $data) { $ok = is $data->data, "Wee Woo", "got same message"; } return $ok; }); note "Now waiting for thread to join"; my $ok = $t->join(); note "Thread joined"; ok($ok, "socket and context not defined in subthread"); } { my $msg = ZeroMQ::Message->new( "Wee Woo" ); my $t = threads->new( sub { return $msg->data eq "Wee Woo" && $msg->size == 7; }); my $ok = $t->join(); ok $ok, "message duped correctly"; }; done_testing; ZeroMQ-0.23/t/103_json.t000644 000765 000024 00000002464 12037235040 015371 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::Requires 'JSON'; BEGIN { use_ok 'ZeroMQ', qw(ZMQ_PAIR ZMQ_NOBLOCK); } { my $structure = { foo => "bar" }; my $cxt = ZeroMQ::Context->new; isa_ok($cxt, 'ZeroMQ::Context'); my $sock = $cxt->socket(ZMQ_PAIR); # Receiver isa_ok($sock, 'ZeroMQ::Socket'); $sock->bind("inproc://myPrivateSocket"); my $client = $cxt->socket(ZMQ_PAIR); # sender $client->connect("inproc://myPrivateSocket"); ok(!defined($sock->recv(ZMQ_NOBLOCK()))); ok($client->send_as( json => $structure ) == 0); my $msg = $sock->recv_as( 'json' ); ok(defined $msg, "received defined msg"); is_deeply($msg, $structure, "received correct message"); } { my $cxt = ZeroMQ::Context->new; isa_ok($cxt, 'ZeroMQ::Context'); can_ok($cxt, 'socket'); my $sock = $cxt->socket(ZMQ_PAIR); # Receiver isa_ok($sock, 'ZeroMQ::Socket'); $sock->bind("inproc://myPrivateSocket"); my $client = $cxt->socket(ZMQ_PAIR); # sender $client->connect("inproc://myPrivateSocket"); my $structure = {some => 'data', structure => [qw/that is json friendly/]}; ok($client->send_as( json => $structure ) == 0); my $msg = $sock->recv_as('json'); ok(defined $msg, "received defined msg"); is_deeply($msg, $structure); } done_testing;ZeroMQ-0.23/t/104_ipc.t000644 000765 000024 00000001422 12037235040 015165 0ustar00daisukestaff000000 000000 use strict; use Test::More tests => 3; use Test::SharedFork; use File::Temp; BEGIN { use_ok "ZeroMQ", qw(ZMQ_REP ZMQ_REQ); } my $path = File::Temp->new(UNLINK => 0); my $pid = Test::SharedFork->fork(); if ($pid == 0) { sleep 1; # hmmm, not a good way to do this... my $ctxt = ZeroMQ::Context->new(); my $child = $ctxt->socket( ZMQ_REQ ); $child->connect( "ipc://$path" ); $child->send( "Hello from $$" ); pass "Send successful"; } elsif ($pid) { my $ctxt = ZeroMQ::Context->new(); my $parent_sock = $ctxt->socket(ZMQ_REP); $parent_sock->bind( "ipc://$path" ); my $msg = $parent_sock->recv; is $msg->data, "Hello from $pid", "message is the expected message"; waitpid $pid, 0; } else { die "Could not fork: $!"; } unlink $path; ZeroMQ-0.23/t/105_poll.t000644 000765 000024 00000003567 12037235040 015375 0ustar00daisukestaff000000 000000 use strict; use warnings; use Test::More; use ZeroMQ qw/:all/; subtest 'Poller with callback' => sub { my $ctxt = ZeroMQ::Context->new(); my $rep = $ctxt->socket(ZMQ_REP); $rep->bind("inproc://polltest"); my $req = $ctxt->socket(ZMQ_REQ); $req->connect("inproc://polltest"); my $called = 0; my $poller = ZeroMQ::Poller->new( { socket => $rep, events => ZMQ_POLLIN, callback => sub { $called++ } } ); ok not $poller->has_event(0); $req->send("Test"); $poller->poll(1); ok $poller->has_event(0); is $called, 1; # repeat, to make sure event does not go away until picked up $poller->poll(1); ok $poller->has_event(0); $rep->recv(); $poller->poll(1); ok not $poller->has_event(0); }; subtest 'Poller with no callback' => sub { my $ctxt = ZeroMQ::Context->new(); my $rep = $ctxt->socket(ZMQ_REP); $rep->bind("inproc://polltest"); my $req = $ctxt->socket(ZMQ_REQ); $req->connect("inproc://polltest"); my $poller = ZeroMQ::Poller->new( { socket => $rep, events => ZMQ_POLLIN, }, ); $req->send("Test"); $poller->poll(1); ok $poller->has_event(0); }; subtest 'Poller with named poll item' => sub { my $ctxt = ZeroMQ::Context->new(); my $rep = $ctxt->socket(ZMQ_REP); $rep->bind("inproc://polltest"); my $req = $ctxt->socket(ZMQ_REQ); $req->connect("inproc://polltest"); my $poller = ZeroMQ::Poller->new( { name => 'test_item', socket => $rep, events => ZMQ_POLLIN, }, ); ok not $poller->has_event('test_item'); $req->send("Test"); $poller->poll(1); ok $poller->has_event('test_item'); $rep->recv(); $poller->poll(1); ok not $poller->has_event('test_item'); }; done_testing; ZeroMQ-0.23/t/cover.sh000755 000765 000024 00000000074 12037235040 015320 0ustar00daisukestaff000000 000000 #!/bin/sh cover -test -ignore_re '^(?:t|etc|modules)/' -gcovZeroMQ-0.23/t/rt64944.t000644 000765 000024 00000010460 12037235040 015070 0ustar00daisukestaff000000 000000 # This test file is used in xt/rt64944.t, but is also in t/ # because it checks (1) failure cases in ZMQ_RCVMORE, and # (2) shows how non-blocking recv() should be handled use strict; use Test::More; use Test::Requires qw( Test::TCP ); BEGIN { use_ok "ZeroMQ"; use_ok "ZeroMQ::Raw"; use_ok "ZeroMQ::Constants", ":all"; } subtest 'blocking recv' => sub { my $server = Test::TCP->new(code => sub { my $port = shift; note "START blocking recv server on port $port"; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_PUB); $sock->bind("tcp://127.0.0.1:$port"); sleep 2; for (1..10) { $sock->send($_); } sleep 2; note "END blocking recv server"; $sock->close; exit 0; }); my $port = $server->port; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_SUB); note "blocking recv client connecting to port $port"; $sock->connect("tcp://127.0.0.1:$port" ); $sock->setsockopt(ZMQ_SUBSCRIBE, ''); for(1..10) { my $msg = $sock->recv(); is $msg->data(), $_; } }; subtest 'non-blocking recv (fail)' => sub { my $server = Test::TCP->new(code => sub { my $port = shift; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_PUB); $sock->bind("tcp://127.0.0.1:$port"); sleep 2; for (1..10) { $sock->send($_); } sleep 2; exit 0; } ); my $port = $server->port; note "non-blocking client connecting to port $port"; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_SUB); $sock->connect("tcp://127.0.0.1:$port" ); $sock->setsockopt(ZMQ_SUBSCRIBE, ''); for(1..10) { my $msg = $sock->recv(ZMQ_RCVMORE); # most of this call should really fail } ok(1); # dummy - this is just here to find leakage }; # Code excericising zmq_poll to do non-blocking recv() subtest 'non-blocking recv (success)' => sub { my $server = Test::TCP->new( code => sub { my $port = shift; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_PUB); $sock->bind("tcp://127.0.0.1:$port"); sleep 2; for (1..10) { $sock->send($_); } sleep 2; exit 0; } ); my $port = $server->port; my $ctxt = zmq_init(); my $sock = zmq_socket( $ctxt, ZMQ_SUB); zmq_connect( $sock, "tcp://127.0.0.1:$port" ); zmq_setsockopt( $sock, ZMQ_SUBSCRIBE, ''); my $timeout = time() + 30; my $recvd = 0; while ( $timeout > time() && $recvd < 10 ) { zmq_poll( [ { socket => $sock, events => ZMQ_POLLIN, callback => sub { while (my $msg = zmq_recv( $sock, ZMQ_RCVMORE)) { is ( zmq_msg_data( $msg ), $recvd + 1 ); $recvd++; } } } ], 1000000 ); # timeout in microseconds, so this is 1 sec } is $recvd, 10, "got all messages"; }; # Code excercising AnyEvent + ZMQ_FD to do non-blocking recv if ($^O ne 'MSWin32' && eval { require AnyEvent } && ! $@) { AnyEvent->import; # want AE namespace my $server = Test::TCP->new( code => sub { my $port = shift; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_PUB); $sock->bind("tcp://127.0.0.1:$port"); sleep 2; for (1..10) { $sock->send($_); } sleep 10; } ); my $port = $server->port; my $ctxt = zmq_init(); my $sock = zmq_socket( $ctxt, ZMQ_SUB); zmq_connect( $sock, "tcp://127.0.0.1:$port" ); zmq_setsockopt( $sock, ZMQ_SUBSCRIBE, ''); my $timeout = time() + 30; my $recvd = 0; my $cv = AE::cv(); my $t; my $fh = zmq_getsockopt( $sock, ZMQ_FD ); my $w; $w = AE::io( $fh, 0, sub { while (my $msg = zmq_recv( $sock, ZMQ_RCVMORE)) { is ( zmq_msg_data( $msg ), $recvd + 1 ); $recvd++; if ( $recvd >= 10 ) { undef $t; undef $w; $cv->send; } } } ); $t = AE::timer( 30, 1, sub { undef $t; undef $w; $cv->send; } ); $cv->recv; is $recvd, 10, "got all messages"; } done_testing; ZeroMQ-0.23/t/rt74653.t000644 000765 000024 00000001707 12037235040 015072 0ustar00daisukestaff000000 000000 use strict; use Test::More; use Test::TCP; use ZeroMQ qw(:all); my $MAX_MESSAGES = 1_000; my $server = Test::TCP->new(code => sub { my $port = shift; my $context = ZeroMQ::Context->new(); my $sender = $context->socket(ZMQ_PUSH); $sender->bind("tcp://*:$port"); # XXX hacky synchronization sleep 3; # The first message is "0" and signals start of batch #$sender->send('0'); my $ident=0; while ($ident < $MAX_MESSAGES) { note "sending ".$ident++,"\n"; $sender->send($ident); } note "Done sending"; sleep(1); # Give 0MQ time to deliver }); { my $context = ZeroMQ::Context->new(); # Socket to receive messages on my $receiver = $context->socket(ZMQ_PULL); $receiver->connect("tcp://localhost:" . $server->port); for my $expected (1..$MAX_MESSAGES) { my $msg = $receiver->recv(); is $msg->data, $expected; } } undef $server; done_testing; ZeroMQ-0.23/lib/ZeroMQ/000755 000765 000024 00000000000 12037235555 015335 5ustar00daisukestaff000000 000000 ZeroMQ-0.23/lib/ZeroMQ.pm000644 000765 000024 00000024356 12037235471 015702 0ustar00daisukestaff000000 000000 package ZeroMQ; use strict; BEGIN { our $VERSION = '0.23'; our @ISA = qw(Exporter); } use ZeroMQ::Raw (); use ZeroMQ::Context; use ZeroMQ::Socket; use ZeroMQ::Message; use ZeroMQ::Poller; use ZeroMQ::Constants; use 5.008; use Carp (); use IO::Handle; our %SERIALIZERS; our %DESERIALIZERS; sub register_read_type { $DESERIALIZERS{$_[0]} = $_[1] } sub register_write_type { $SERIALIZERS{$_[0]} = $_[1] } sub import { my $class = shift; if (@_) { ZeroMQ::Constants->export_to_level( 1, $class, @_ ); } } sub _get_serializer { $SERIALIZERS{$_[1]} } sub _get_deserializer { $DESERIALIZERS{$_[1]} } eval { require JSON; JSON->import(2.00); register_read_type(json => \&JSON::decode_json); register_write_type(json => \&JSON::encode_json); }; 1; __END__ =head1 NAME ZeroMQ - A ZeroMQ2 wrapper for Perl (DEPRECATED) =head1 SYNOPSIS ( HIGH-LEVEL API ) # echo server use ZeroMQ qw/:all/; my $cxt = ZeroMQ::Context->new; my $sock = $cxt->socket(ZMQ_REP); $sock->bind($addr); my $msg; foreach (1..$roundtrip_count) { $msg = $sock->recv(); $sock->send($msg); } # json (if JSON.pm is available) $sock->send_as( json => { foo => "bar" } ); my $thing = $sock->recv_as( "json" ); # custom serialization ZeroMQ::register_read_type(myformat => sub { ... }); ZeroMQ::register_write_type(myformat => sub { .. }); $sock->send_as( myformat => $data ); # serialize using above callback my $thing = $sock->recv_as( "myformat" ); =head1 SYNOPSIS ( LOW-LEVEL API ) use ZeroMQ::Raw; my $ctxt = zmq_init($threads); my $rv = zmq_term($ctxt); my $msg = zmq_msg_init(); my $msg = zmq_msg_init_size( $size ); my $msg = zmq_msg_init_data( $data ); my $rv = zmq_msg_close( $msg ); my $rv = zmq_msg_move( $dest, $src ); my $rv = zmq_msg_copy( $dest, $src ); my $data = zmq_msg_data( $msg ); my $size = zmq_msg_size( $msg); my $sock = zmq_socket( $ctxt, $type ); my $rv = zmq_close( $sock ); my $rv = zmq_setsockopt( $socket, $option, $value ); my $val = zmq_getsockopt( $socket, $option ); my $rv = zmq_bind( $sock, $addr ); my $rv = zmq_send( $sock, $msg, $flags ); my $msg = zmq_recv( $sock, $flags ); =head1 INSTALLATION If you have libzmq registered with pkg-config: perl Makefile.PL make make test make install If you don't have pkg-config, and libzmq is installed under /usr/local/libzmq: ZMQ_HOME=/usr/local/libzmq \ perl Makefile.PL make make test make install If you want to customize include directories and such: ZMQ_INCLUDES=/path/to/libzmq/include \ ZMQ_LIBS=/path/to/libzmq/lib \ ZMQ_H=/path/to/libzmq/include/zmq.h \ perl Makefile.PL make make test make install If you want to compile with debugging on: perl Makefile.PL -g =head1 DESCRIPTION Please note that this module has been DEPRECATED in favor of L, L, and L. see https://github.com/lestrrat/p5-ZMQ and other CPAN pages. The C module is a wrapper of the 0MQ message passing library for Perl. It's a thin wrapper around the C API. Please read L for more details on ZeroMQ. =head1 CLASS WALKTHROUGH =over 4 =item ZeroMQ::Raw Use L to get access to the C API such as C, C, et al. Functions provided in this low level API should follow the C API exactly. =item ZeroMQ::Constants L contains all of the constants that are known to be extractable from zmq.h. Do note that sometimes the list changes due to additions/deprecations in the underlying zeromq2 library. We try to do our best to make things available (at least to warn you that some symbols are deprecated), but it may not always be possible. =item ZeroMQ::Context =item ZeroMQ::Socket =item ZeroMQ::Message L, L, L contain the high-level, more perl-ish interface to the zeromq functionalities. =item ZeroMQ Loading C will make the L, L, and L classes available as well. =back =head1 BASIC USAGE To start using ZeroMQ, you need to create a context object, then as many ZeroMQ::Socket as you need: my $ctxt = ZeroMQ::Context->new; my $socket = $ctxt->socket( ... options ); You need to call C or C on the socket, depending on your usage. For example on a typical server-client model you would write on the server side: $socket->bind( "tcp://127.0.0.1:9999" ); and on the client side: $socket->connect( "tcp://127.0.0.1:9999" ); The underlying zeromq library offers TCP, multicast, in-process, and ipc connection patterns. Read the zeromq manual for more details on other ways to setup the socket. When sending data, you can either pass a ZeroMQ::Message object or a Perl string. # the following two send() calls are equivalent my $msg = ZeroMQ::Message->new( "a simple message" ); $socket->send( $msg ); $socket->send( "a simple message" ); In most cases using ZeroMQ::Message is redundunt, so you will most likely use the string version. To receive, simply call C on the socket my $msg = $socket->recv; The received message is an instance of ZeroMQ::Message object, and you can access the content held in the message via the C method: my $data = $msg->data; =head1 SERIALIZATION ZeroMQ.pm comes with a simple serialization/deserialization mechanism. To serialize, use C to register a name and an associated callback to serialize the data. For example, for JSON we do the following (this is already done for you in ZeroMQ.pm if you have JSON.pm installed): use JSON (); ZeroMQ::register_write_type('json' => \&JSON::encode_json); ZeroMQ::register_read_type('json' => \&JSON::decode_json); Then you can use C and C to specify the serialization type as the first argument: my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket( ZMQ_REQ ); $sock->send_as( json => $complex_perl_data_structure ); The otherside will receive a JSON encoded data. The receivind side can be written as: my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket( ZMQ_REP ); my $complex_perl_data_structure = $sock->recv_as( 'json' ); If you have JSON.pm (must be 2.00 or above), then the JSON serializer / deserializer is automatically enabled. If you want to tweak the serializer option, do something like this: my $coder = JSON->new->utf8->pretty; # pretty print ZeroMQ::register_write_type( json => sub { $coder->encode($_[0]) } ); ZeroMQ::register_read_type( json => sub { $coder->decode($_[0]) } ); Note that this will have a GLOBAL effect. If you want to change only your application, use a name that's different from 'json'. =head1 ASYNCHRONOUS I/O WITH ZEROMQ By default ZeroMQ comes with its own zmq_poll() mechanism that can handle non-blocking sockets. You can use this by calling zmq_poll with a list of hashrefs: zmq_poll([ { fd => fileno(STDOUT), events => ZMQ_POLLOUT, callback => \&callback, }, { socket => $zmq_socket, events => ZMQ_POLLIN, callback => \&callback }, ], $timeout ); Unfortunately this custom polling scheme doesn't play too well with AnyEvent. As of zeromq2-2.1.0, you can use getsockopt to retrieve the underlying file descriptor, so use that to integrate ZeroMQ and AnyEvent: my $socket = zmq_socket( $ctxt, ZMQ_REP ); my $fh = zmq_getsockopt( $socket, ZMQ_FD ); my $w; $w = AE::io $fh, 0, sub { while ( my $msg = zmq_recv( $socket, ZMQ_RCVMORE ) ) { # do something with $msg; } undef $w; }; =head1 NOTES ON MULTI-PROCESS and MULTI-THREADED USAGE ZeroMQ works on both multi-process and multi-threaded use cases, but you need to be careful bout sharing ZeroMQ objects. For multi-process environments, you should not be sharing the context object. Create separate contexts for each process, and therefore you shouldn't be sharing the socket objects either. For multi-thread environemnts, you can share the same context object. However you cannot share sockets. =head1 FUNCTIONS =head2 version() Returns the version of the underlying zeromq library that is being linked. In scalar context, returns a dotted version string. In list context, returns a 3-element list of the version numbers: my $version_string = ZeroMQ::version(); my ($major, $minor, $patch) = ZeroMQ::version(); =head2 device($type, $sock1, $sock2) =head2 register_read_type($name, \&callback) Register a read callback for a given C<$name>. This is used in C. The callback receives the data received from the socket. =head2 register_write_type($name, \&callback) Register a write callback for a given C<$name>. This is used in C The callback receives the Perl structure given to C =head1 DEBUGGING XS If you see segmentation faults, and such, you need to figure out where the error is occuring in order for the maintainers to figure out what happened. Here's a very very brief explanation of steps involved. First, make sure to compile ZeroMQ.pm with debugging on by specifying -g: perl Makefile.PL -g make Then fire gdb: gdb perl (gdb) R -Mblib /path/to/your/script.pl When you see the crash, get a backtrace: (gdb) bt =head1 CAVEATS This is an early release. Proceed with caution, please report (or better yet: fix) bugs you encounter. This module has been tested againt B. Semantics of this module rely heavily on the underlying zeromq version. Make sure you know which version of zeromq you're working with. =head1 SEE ALSO L, L, L, L L L =head1 AUTHOR Daisuke Maki C<< >> Steffen Mueller, C<< >> =head1 COPYRIGHT AND LICENSE The ZeroMQ module is Copyright (C) 2010 by Daisuke Maki This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.0 or, at your option, any later version of Perl 5 you may have available. =cut ZeroMQ-0.23/lib/ZeroMQ/Constants.pm000644 000765 000024 00000007702 12037235040 017642 0ustar00daisukestaff000000 000000 package ZeroMQ::Constants; use strict; use base qw(Exporter); use ZeroMQ (); # TODO: keep in sync with docs below and Makefile.PL BEGIN { my @possibly_nonexistent = qw( ZMQ_BACKLOG ZMQ_FD ZMQ_LINGER ZMQ_EVENTS ZMQ_RECONNECT_IVL ZMQ_RECONNECT_IVL_MAX ZMQ_SWAP ZMQ_TYPE ZMQ_VERSION ZMQ_VERSION_MAJOR ZMQ_VERSION_MINOR ZMQ_VERSION_PATCH ); my $version = ZeroMQ::version(); foreach my $symbol (@possibly_nonexistent) { if (! __PACKAGE__->can($symbol) ) { no strict 'refs'; *{$symbol} = sub { Carp::croak("$symbol is not available in zeromq2 $version") }; }; } } # XXX ZMQ_NOBLOCK needs to be deprecated, but doing this for compat # for now... we need to get rid of it when we release it if ( ZMQ_VERSION_MAJOR >= 3 ) { *ZMQ_NOBLOCK = \&ZMQ_DONTWAIT; } our %EXPORT_TAGS = ( # socket types socket => [ qw( ZMQ_PAIR ZMQ_PUB ZMQ_SUB ZMQ_REQ ZMQ_REP ZMQ_XREQ ZMQ_XREP ZMQ_XSUB ZMQ_XPUB ZMQ_ROUTER ZMQ_DEALER ZMQ_PULL ZMQ_PUSH ZMQ_UPSTREAM ZMQ_DOWNSTREAM ZMQ_BACKLOG ), # socket send/recv flags qw( ZMQ_NOBLOCK ZMQ_SNDMORE ), # get/setsockopt options qw( ZMQ_HWM ZMQ_SWAP ZMQ_AFFINITY ZMQ_IDENTITY ZMQ_SUBSCRIBE ZMQ_UNSUBSCRIBE ZMQ_RATE ZMQ_RECOVERY_IVL ZMQ_RECOVERY_IVL_MAX ZMQ_MCAST_LOOP ZMQ_SNDBUF ZMQ_RCVBUF ZMQ_RCVMORE ZMQ_RECONNECT_IVL ZMQ_RECONNECT_IVL_MAX ZMQ_LINGER ZMQ_FD ZMQ_EVENTS ZMQ_TYPE ), # i/o multiplexing qw( ZMQ_POLLIN ZMQ_POLLOUT ZMQ_POLLERR ), ], # devices device => [ qw( ZMQ_QUEUE ZMQ_FORWARDER ZMQ_STREAMER ), ], # max size of vsm message message => [ qw( ZMQ_MAX_VSM_SIZE ), # message types qw( ZMQ_DELIMITER ZMQ_VSM ), # message flags qw( ZMQ_MSG_MORE ZMQ_MSG_SHARED ),] ); $EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ]; our @EXPORT_OK = ( qw( ZMQ_RECOVERY_IVL_MSEC ZMQ_HAUSNUMERO ZMQ_VERSION ZMQ_VERSION_MAJOR ZMQ_VERSION_MINOR ZMQ_VERSION_PATCH ), @{ $EXPORT_TAGS{'all'} } ); 1; __END__ =head1 NAME ZeroMQ::Constants - ZeroMQ Constants =head1 EXPORTS You may choose to import one or more (using the C<:all> import tag) constants into your namespace by supplying arguments to the C call as shown in the synopsis above. The exportable constants are: =head2 C<:socket> - Socket types and socket options =over 4 =item ZMQ_PAIR =item ZMQ_PUB =item ZMQ_SUB =item ZMQ_REQ =item ZMQ_REP =item ZMQ_XREQ =item ZMQ_XREP =item ZMQ_XPUB =item ZMQ_XSUB =item ZMQ_ROUTER =item ZMQ_DEALER =item ZMQ_PULL =item ZMQ_PUSH =item ZMQ_UPSTREAM =item ZMQ_DOWNSTREAM =item ZMQ_BACKLOG =item ZMQ_FD =item ZMQ_LINGER =item ZMQ_EVENTS =item ZMQ_RECONNECT_IVL =item ZMQ_RECONNECT_IVL_MAX =item ZMQ_TYPE =item ZMQ_NOBLOCK =item ZMQ_SNDMORE =item ZMQ_HWM =item ZMQ_SWAP =item ZMQ_AFFINITY =item ZMQ_IDENTITY =item ZMQ_SUBSCRIBE =item ZMQ_UNSUBSCRIBE =item ZMQ_RATE =item ZMQ_RECOVERY_IVL =item ZMQ_MCAST_LOOP =item ZMQ_SNDBUF =item ZMQ_RCVBUF =item ZMQ_RCVMORE =item ZMQ_POLLIN =item ZMQ_POLLOUT =item ZMQ_POLLERR =item ZMQ_RECOVERY_IVL_MSEC =back =head2 C<:device> - Device types =over 4 =item ZMQ_QUEUE =item ZMQ_FORWARDER =item ZMQ_STREAMER =back =head2 C<:message> - Message Options =over 4 =item ZMQ_MAX_VSM_SIZE =item ZMQ_DELIMITER =item ZMQ_VSM =item ZMQ_MSG_MORE =item ZMQ_MSG_SHARED =back =head2 miscellaneous =over 4 =item ZMQ_HAUSNUMERO =item ZMQ_VERSION =item ZMQ_VERSION_MAJOR =item ZMQ_VERSION_MINOR =item ZMQ_VERSION_PATCH =back =head2 uncategorized =cut ZeroMQ-0.23/lib/ZeroMQ/Context.pm000644 000765 000024 00000003753 12037235040 017314 0ustar00daisukestaff000000 000000 package ZeroMQ::Context; use strict; use ZeroMQ::Raw (); sub new { my ($class, $nthreads) = @_; if (! defined $nthreads || $nthreads <= 0) { $nthreads = 1; } bless { _ctxt => ZeroMQ::Raw::zmq_init($nthreads), }, $class; } sub ctxt { $_[0]->{_ctxt}; } sub socket { return ZeroMQ::Socket->new(@_); # $_[0] should contain the context } sub term { my $self = shift; ZeroMQ::Raw::zmq_term($self->ctxt); } 1; __END__ =head1 NAME ZeroMQ::Context - A 0MQ Context object =head1 SYNOPSIS use ZeroMQ qw/:all/; my $cxt = ZeroMQ::Context->new; my $sock = ZeroMQ::Socket->new($cxt, ZMQ_REP); =head1 DESCRIPTION Before opening any 0MQ Sockets, the caller must initialise a 0MQ context. =head1 METHODS =head2 new($nthreads) Creates a new C. Optional arguments: The number of io threads to use. Defaults to 1. =head2 term() Terminates the current context. You *RARELY* need to call this yourself, so don't do it unless you know what you're doing. =head2 socket($type) Short hand for ZeroMQ::Socket::new. =head2 ctxt Return the underlying ZeroMQ::Raw::Context object =head1 CAVEATS While in principle, C objects are thread-safe, they are currently not cloned when a new Perl ithread is spawned. The variables in the new thread that contained the context in the parent thread will be a scalar reference to C in the new thread. This could be fixed with better control over the destructor calls. =head1 SEE ALSO L, L L L, L =head1 AUTHOR Daisuke Maki Edaisuke@endeworks.jpE Steffen Mueller, Esmueller@cpan.orgE =head1 COPYRIGHT AND LICENSE The ZeroMQ module is Copyright (C) 2010 by Daisuke Maki This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.0 or, at your option, any later version of Perl 5 you may have available. =cut ZeroMQ-0.23/lib/ZeroMQ/Message.pm000644 000765 000024 00000003440 12037235040 017245 0ustar00daisukestaff000000 000000 package ZeroMQ::Message; use strict; sub new { my ($class, $data) = @_; bless { _message => ZeroMQ::Raw::zmq_msg_init_data( $data ) }, $class; } sub new_from_message { my ($class, $message) = @_; bless { _message => $message }, $class; } sub message { $_[0]->{_message}; } sub data { ZeroMQ::Raw::zmq_msg_data( $_[0]->message ); } sub size { ZeroMQ::Raw::zmq_msg_size( $_[0]->message ); } 1; __END__ =head1 NAME ZeroMQ::Message - A 0MQ Message object =head1 SYNOPSIS use ZeroMQ qw/:all/; my $cxt = ZeroMQ::Context->new; my $sock = ZeroMQ::Socket->new($cxt, ZMQ_REP); my $msg = ZeroMQ::Message->new($text); $sock->send($msg); my $anothermsg = $sock->recv; =head1 DESCRIPTION A C object represents a message to be passed over a C. =head1 METHODS =head2 new Creates a new C. Takes the data to send with the message as argument. =head2 new_from_message( $rawmsg ) Creates a new C. Takes a ZeroMQ::Raw::Message object as argument. =head2 message Return the underlying ZeroMQ::Raw::Message object. =head2 size Returns the length (in bytes) of the contained data. =head2 data Returns the data as a (potentially binary) string. =head1 SEE ALSO L, L, L L L, L =head1 AUTHOR Daisuke Maki Edaisuke@endeworks.jpE Steffen Mueller, Esmueller@cpan.orgE =head1 COPYRIGHT AND LICENSE The ZeroMQ module is Copyright (C) 2010 by Daisuke Maki This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.0 or, at your option, any later version of Perl 5 you may have available. =cut ZeroMQ-0.23/lib/ZeroMQ/Poller.pm000644 000765 000024 00000011110 12037235040 017107 0ustar00daisukestaff000000 000000 package ZeroMQ::Poller; use strict; use warnings; use ZeroMQ::Raw qw(zmq_poll); use Scalar::Util qw(looks_like_number weaken); sub new { my ($class, @poll_items) = @_; bless { _poll_items => \@poll_items, _events => [], _named_events => {}, }, $class; } sub poll { my ($self, $timeout) = @_; if (! defined $timeout ) { $timeout = -1; } $self->_clear_events(); zmq_poll($self->_raw_poll_items, $timeout); } sub _clear_events { my ($self) = @_; $self->{_events} = []; $self->{_named_events} = {}; } sub _raw_poll_items { my ($self) = @_; unless ($self->{_raw_poll_items}) { my @raw_poll_items; my @poll_items = $self->_poll_items; for (my $i = 0; $i < @poll_items; ++$i) { push @raw_poll_items, $self->_make_raw_poll_item_with_event_callback($poll_items[$i], $i) ; } $self->{_raw_poll_items} = \@raw_poll_items; } return $self->{_raw_poll_items}; } sub _make_raw_poll_item_with_event_callback { my ($self, $poll_item, $index) = @_; my $name = $poll_item->{name}; my $raw_poll_item = $self->_make_raw_poll_item($poll_item); my $callback = $raw_poll_item->{callback}; weaken $self; $raw_poll_item->{callback} = sub { $callback->() if $callback; $self->_mark_event_received($index, $name); }; return $raw_poll_item; } sub _make_raw_poll_item { my ($self, $poll_item) = @_; my $raw_poll_item = { events => $poll_item->{events}, callback => $poll_item->{callback}, }; if ( defined $poll_item->{socket} ) { $raw_poll_item->{socket} = $poll_item->{socket}->socket; } elsif ( defined $poll_item->{fd} ) { $raw_poll_item->{fd} = $poll_item->{fd}; } return $raw_poll_item; } sub _mark_event_received { my ($self, $index, $name) = @_; $self->{_events}->[$index] = 1; if (defined $name) { $self->{_named_events}->{$name} = 1; } } sub _poll_items { @{ $_[0]->{_poll_items} } } sub has_event { my ($self, $which) = @_; return ( looks_like_number $which ? $self->_has_event_by_index($which) : $self->_has_event_by_name($which) ); } sub _has_event_by_index { my ($self, $index) = @_; return !!$self->_events->[$index]; } sub _events { $_[0]->{_events} } sub _has_event_by_name { my ($self, $name) = @_; return !!$self->_named_events->{$name}; } sub _named_events { $_[0]->{_named_events} } 1; __END__ =head1 NAME ZeroMQ::Poller - Convenient socket polling object =head1 SYNOPSIS use ZeroMQ qw/:all/; my $cxt = ZeroMQ::Context->new() my $sock = ZeroMQ::Socket->new($cxt, ZMQ_REP); $sock->bind("inproc://amazingsocket"); my $poller = ZeroMQ::Poller->new( { name => 'amazing', socket => $sock, events => ZMQ_POLLIN, callback => sub { do_something_amazing }, }, ); $poller->poll(); do_another_amazing_thing() if $poller->has_event(0); do_a_third_amazing_thing() if $poller->has_event('amazing'); =head1 DESCRIPTION A C watches zero or more sockets for events and signals that these have occurred in several ways. Given a list of sockets and events to watch for, it can directly invoke a callback or simply raise a flag. =head1 METHODS =head2 new(@poll_items) Creates a new C The constructor accepts a list of hash references ("poll items"), each of which specifies a socket or file descriptor to watch and what to watch it for. In addition, each poll item may specify a callback to invoke or a name by which it may be queried. The accepted keys are: =over 4 =item socket Contains the C item to poll. =item fd Contains the file descriptor to poll. One of C or C is required; C has precedence. =item events Some combination of C, C, and C; the events to trap. =item callback A coderef taking no arguments and emitting no return value, invoked when the specified events occur on the socket or file descriptor. Optional. =item name A string, naming the poll item for later use with C. =back =head2 poll($timeout) Blocks until there is activity or the given timeout is reached. If no timeout or a negative timeout is specified, blocks indefinitely. If a timeout is given, it is interpreted as microseconds. =head2 has_event($index) =head2 has_event($name) Returns true if the poll item at the given index or with the given name reported activity during the last call to C. =cut ZeroMQ-0.23/lib/ZeroMQ/Raw.pm000644 000765 000024 00000003272 12037235465 016430 0ustar00daisukestaff000000 000000 package ZeroMQ::Raw; use strict; use XSLoader; BEGIN { our @ISA = qw(Exporter); # XXX it's a hassle, but keep it in sync with ZeroMQ.pm # by loading this here, we can make ZeroMQ::Raw independent # of ZeroMQ while keeping the dist name as ZeroMQ XSLoader::load('ZeroMQ', '0.23'); } our @EXPORT = qw( zmq_init zmq_term zmq_msg_close zmq_msg_data zmq_msg_init zmq_msg_init_data zmq_msg_init_size zmq_msg_size zmq_msg_copy zmq_msg_move zmq_bind zmq_close zmq_connect zmq_getsockopt zmq_recv zmq_send zmq_setsockopt zmq_socket zmq_poll zmq_device ); 1; __END__ =head1 NAME ZeroMQ::Raw - Low-level API for ZeroMQ =head1 FUNCTIONS =head2 zmq_init =head2 zmq_term =head2 zmq_msg_close =head2 zmq_msg_data =head2 zmq_msg_init =head2 zmq_msg_init_data =head2 zmq_msg_init_size =head2 zmq_msg_size =head2 zmq_msg_move =head2 zmq_msg_copy =head2 zmq_bind =head2 zmq_close =head2 zmq_connect =head2 zmq_getsockopt =head2 zmq_recv =head2 zmq_send =head2 zmq_setsockopt =head2 zmq_socket =head2 zmq_poll( \@list_of_hashrefs, $timeout ) Calls zmq_poll on the given items as specified by @list_of_hashrefs. Each element in @list_of_hashrefs should be a hashref containing the following keys: =over 4 =item socket Contains the ZeroMQ::Raw::Socket object to poll. =item fd Contains the file descriptor to poll. Either one of socket or fd must be specified. If both are specified, 'socket' will take precedence. =item events A bitmask of ZMQ_POLLIN, ZMQ_POLLOUT, ZMQ_POLLERR =item callback Callback that gets invoked. Takes no arguments. =back =head2 zmq_device( device, insocket, outsocket ) =cut ZeroMQ-0.23/lib/ZeroMQ/Socket.pm000644 000765 000024 00000022216 12037235040 017113 0ustar00daisukestaff000000 000000 package ZeroMQ::Socket; use strict; use Carp(); use ZeroMQ (); use Scalar::Util qw(blessed); BEGIN { my @map = qw( setsockopt getsockopt bind connect close ); foreach my $method (@map) { my $code = << "EOSUB"; sub $method { my \$self = shift; ZeroMQ::Raw::zmq_$method( \$self->socket, \@_ ); } EOSUB eval $code; die if $@; } } sub new { my ($class, $ctxt, @args) = @_; if ( eval { $ctxt->isa( 'ZeroMQ::Context' ) } ) { $ctxt = $ctxt->ctxt; } bless { _socket => ZeroMQ::Raw::zmq_socket( $ctxt, @args ), }, $class; } sub socket { $_[0]->{_socket}; } sub recv { my ($self, $flags) = @_; $flags ||= 0; my $rawmsg = ZeroMQ::Raw::zmq_recv( $self->socket, $flags ); return $rawmsg ? ZeroMQ::Message->new_from_message( $rawmsg ) : () ; } sub send { my ($self, $msg, $flags) = @_; if (blessed $msg and $msg->isa( 'ZeroMQ::Message' ) ) { $msg = $msg->message; } $flags ||= 0; ZeroMQ::Raw::zmq_send( $self->socket, $msg, $flags ); } sub recv_as { my ($self, $type, $flags) = @_; my $deserializer = ZeroMQ->_get_deserializer( $type ); if (! $deserializer ) { Carp::croak("No deserializer $type found"); } my $msg = $self->recv( $flags ) or return; $deserializer->( $msg->data ); } sub send_as { my ($self, $type, $data) = @_; my $serializer = ZeroMQ->_get_serializer( $type ); if (! $serializer ) { Carp::croak("No serializer $type found"); } $self->send( $serializer->( $data ) ); } 1; __END__ =head1 NAME ZeroMQ::Socket - A 0MQ Socket object =head1 SYNOPSIS use ZeroMQ qw/:all/; my $cxt = ZeroMQ::Context->new; my $sock = ZeroMQ::Socket->new($cxt, ZMQ_REP); =head1 DESCRIPTION 0MQ sockets present an abstraction of a asynchronous message queue, with the exact queueing semantics depending on the socket type in use. =head2 Key differences to conventional sockets Quoting the 0MQ manual: Generally speaking, conventional sockets present a synchronous interface to either connection-oriented reliable byte streams (C), or connection-less unreliable datagrams (C). In comparison, 0MQ sockets present an abstraction of an asynchronous message queue, with the exact queueing semantics depending on the socket type in use. Where conventional sockets transfer streams of bytes or discrete datagrams, 0MQ sockets transfer discrete messages. 0MQ sockets being asynchronous means that the timings of the physical connection setup and teardown, reconnect and effective delivery are transparent to the user and organized by 0MQ itself. Further, messages may be queued in the event that a peer is unavailable to receive them. Conventional sockets allow only strict one-to-one (two peers), many-to-one (many clients, one server), or in some cases one-to-many (multicast) relationships. With the exception of C, 0MQ sockets may be connected to multiple endpoints using c, while simultaneously accepting incoming connections from multiple endpoints bound to the socket using c, thus allowing many-to-many relationships. =head2 Socket types For detailed explanations of the socket types, check the official 0MQ documentation. This is just a short list of types: =over 2 =item Request-reply pattern The C type is for the client that sends, then receives. The C type is for the server that receives a message, then answers. =item Publish-subscribe pattern The C type is for publishing messages to an arbitrary number of subscribers only. The C type is for subscribers that receive messages. =item Pipeline pattern The C socket type sends messages in a pipeline pattern. C receives them. =item Exclusive pair pattern The C type allows bidirectional message passing between two participants. =back =head1 METHODS =head2 new Creates a new C. First argument must be the L in which the socket is to live. Second argument is the socket type. The newly created socket is initially unbound, and not associated with any endpoints. In order to establish a message flow a socket must first be connected to at least one endpoint with the C method or at least one endpoint must be created for accepting incoming connections with the C method. =head2 bind The C method function creates an endpoint for accepting connections and binds it to the socket. Quoting the 0MQ manual: The endpoint argument is a string consisting of two parts as follows: C. The transport part specifies the underlying transport protocol to use. The meaning of the address part is specific to the underlying transport protocol selected. The following transports are defined. Refer to the 0MQ manual for details. =over 2 =item inproc Local in-process (inter-thread) communication transport. =item ipc Local inter-process communication transport. =item tcp Unicast transport using TCP. =item pgm, epgm Reliable multicast transport using PGM. =back With the exception of C sockets, a single socket may be connected to multiple endpoints using C, while simultaneously accepting incoming connections from multiple endpoints bound to the socket using C)>. The exact semantics depend on the socket type. =head2 connect Connect to an existing endpoint. Takes an enpoint string as argument, see the documentation for C above. =head2 close =head2 send The C method queues the given message to be sent to the socket. The flags argument is a combination of the flags defined below. =head2 send_as( $type, $message, $flags ) =over 2 =item ZMQ_NOBLOCK Specifies that the operation should be performed in non-blocking mode. If the message cannot be queued on the socket, the C method fails with errno set to EAGAIN. =item ZMQ_SNDMORE Specifies that the message being sent is a multi-part message, and that further message parts are to follow. Refer to the 0MQ manual for details regarding multi-part messages. =back =head2 recv The Crecv($flags)> method receives a message from the socket and returns it as a new C object. If there are no messages available on the specified socket the C method blocks until the request can be satisfied. The flags argument is a combination of the flags defined below. =head2 recv_as( $type, $flags ) =over 2 =item ZMQ_NOBLOCK Specifies that the operation should be performed in non-blocking mode. If there are no messages available on the specified socket, the C<$sock-Erecv(ZMQ_NOBLOCK)> method call returns C and sets C<$ERRNO> to C. =back =head2 getsockopt The Cgetsockopt(ZMQ_SOME_OPTION)> method call retrieves the value for the given socket option. The following options can be retrieved. For a full explanation of the options, please refer to the 0MQ manual. =over 2 =item ZMQ_RCVMORE: More message parts to follow =item ZMQ_HWM: Retrieve high water mark =item ZMQ_SWAP: Retrieve disk offload size =item ZMQ_AFFINITY: Retrieve I/O thread affinity =item ZMQ_IDENTITY: Retrieve socket identity =item ZMQ_RATE: Retrieve multicast data rate =item ZMQ_RECOVERY_IVL: Get multicast recovery interval =item ZMQ_MCAST_LOOP: Control multicast loopback =item ZMQ_SNDBUF: Retrieve kernel transmit buffer size =item ZMQ_RCVBUF: Retrieve kernel receive buffer size =back =head2 setsockopt The C<$sock-Esetsockopt(ZMQ_SOME_OPTION, $value)> method call sets the specified option to the given value. The following socket options can be set. For details, please refer to the 0MQ manual: =over 2 =item ZMQ_HWM: Set high water mark =item ZMQ_SWAP: Set disk offload size =item ZMQ_AFFINITY: Set I/O thread affinity =item ZMQ_IDENTITY: Set socket identity =item ZMQ_SUBSCRIBE: Establish message filter =item ZMQ_UNSUBSCRIBE: Remove message filter =item ZMQ_RATE: Set multicast data rate =item ZMQ_RECOVERY_IVL: Set multicast recovery interval =item ZMQ_MCAST_LOOP: Control multicast loopback =item ZMQ_SNDBUF: Set kernel transmit buffer size =item ZMQ_RCVBUF: Set kernel receive buffer size =back =head1 CAVEATS C objects aren't thread safe due to the underlying library. Therefore, they are currently not cloned when a new Perl ithread is spawned. The variables in the new thread that contained the socket in the parent thread will be a scalar reference to C in the new thread. This makes the Perl wrapper thread safe (i.e. no segmentation faults). =head1 SEE ALSO L, L L L, L =head1 AUTHOR Daisuke Maki Edaisuke@endeworks.jpE Steffen Mueller, Esmueller@cpan.orgE =head1 COPYRIGHT AND LICENSE The ZeroMQ module is Copyright (C) 2010 by Daisuke Maki This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.0 or, at your option, any later version of Perl 5 you may have available. =cut ZeroMQ-0.23/inc/Devel/000755 000765 000024 00000000000 12037235555 015222 5ustar00daisukestaff000000 000000 ZeroMQ-0.23/inc/Module/000755 000765 000024 00000000000 12037235555 015410 5ustar00daisukestaff000000 000000 ZeroMQ-0.23/inc/Module/Install/000755 000765 000024 00000000000 12037235555 017016 5ustar00daisukestaff000000 000000 ZeroMQ-0.23/inc/Module/Install.pm000644 000765 000024 00000030135 12037235552 017353 0ustar00daisukestaff000000 000000 #line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. ZeroMQ-0.23/inc/Module/Install/AuthorTests.pm000644 000765 000024 00000002215 12037235553 021637 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::AuthorTests; use 5.005; use strict; use Module::Install::Base; use Carp (); #line 16 use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.002'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } #line 42 sub author_tests { my ($self, @dirs) = @_; _add_author_tests($self, \@dirs, 0); } #line 56 sub recursive_author_tests { my ($self, @dirs) = @_; _add_author_tests($self, \@dirs, 1); } sub _wanted { my $href = shift; sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 } } sub _add_author_tests { my ($self, $dirs, $recurse) = @_; return unless $Module::Install::AUTHOR; my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t'; # XXX: pick a default, later -- rjbs, 2008-02-24 my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests"; @dirs = grep { -d } @dirs; if ($recurse) { require File::Find; my %test_dir; File::Find::find(_wanted(\%test_dir), @dirs); $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir ); } else { $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs ); } } #line 107 1; ZeroMQ-0.23/inc/Module/Install/Base.pm000644 000765 000024 00000002147 12037235553 020230 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 ZeroMQ-0.23/inc/Module/Install/Can.pm000644 000765 000024 00000006157 12037235553 020064 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 ZeroMQ-0.23/inc/Module/Install/CheckLib.pm000644 000765 000024 00000002442 12037235553 021020 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::CheckLib; use strict; use warnings; use File::Spec; use base qw(Module::Install::Base); use vars qw($VERSION); $VERSION = '0.08'; sub checklibs { my $self = shift; my @parms = @_; return unless scalar @parms; unless ( $Module::Install::AUTHOR ) { require Devel::CheckLib; Devel::CheckLib::check_lib_or_exit( @parms ); return; } _author_side(); } sub assertlibs { my $self = shift; my @parms = @_; return unless scalar @parms; unless ( $Module::Install::AUTHOR ) { require Devel::CheckLib; Devel::CheckLib::assert_lib( @parms ); return; } _author_side(); } sub _author_side { mkdir 'inc'; mkdir 'inc/Devel'; print "Extra directories created under inc/\n"; require Devel::CheckLib; local $/ = undef; open(CHECKLIBPM, $INC{'Devel/CheckLib.pm'}) || die("Can't read $INC{'Devel/CheckLib.pm'}: $!"); (my $checklibpm = ) =~ s/package Devel::CheckLib/package #\nDevel::CheckLib/; close(CHECKLIBPM); open(CHECKLIBPM, '>'.File::Spec->catfile(qw(inc Devel CheckLib.pm))) || die("Can't write inc/Devel/CheckLib.pm: $!"); print CHECKLIBPM $checklibpm; close(CHECKLIBPM); print "Copied Devel::CheckLib to inc/ directory\n"; return 1; } 'All your libs are belong'; __END__ #line 126 ZeroMQ-0.23/inc/Module/Install/Fetch.pm000644 000765 000024 00000004627 12037235553 020414 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; ZeroMQ-0.23/inc/Module/Install/Makefile.pm000644 000765 000024 00000027437 12037235553 021104 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 ZeroMQ-0.23/inc/Module/Install/Metadata.pm000644 000765 000024 00000043277 12037235553 021107 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; ZeroMQ-0.23/inc/Module/Install/ReadmeFromPod.pm000644 000765 000024 00000006311 12037235553 022037 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::ReadmeFromPod; use 5.006; use strict; use warnings; use base qw(Module::Install::Base); use vars qw($VERSION); $VERSION = '0.18'; sub readme_from { my $self = shift; return unless $self->is_admin; # Input file my $in_file = shift || $self->_all_from or die "Can't determine file to make readme_from"; # Get optional arguments my ($clean, $format, $out_file, $options); my $args = shift; if ( ref $args ) { # Arguments are in a hashref if ( ref($args) ne 'HASH' ) { die "Expected a hashref but got a ".ref($args)."\n"; } else { $clean = $args->{'clean'}; $format = $args->{'format'}; $out_file = $args->{'output_file'}; $options = $args->{'options'}; } } else { # Arguments are in a list $clean = $args; $format = shift; $out_file = shift; $options = \@_; } # Default values; $clean ||= 0; $format ||= 'txt'; # Generate README print "readme_from $in_file to $format\n"; if ($format =~ m/te?xt/) { $out_file = $self->_readme_txt($in_file, $out_file, $options); } elsif ($format =~ m/html?/) { $out_file = $self->_readme_htm($in_file, $out_file, $options); } elsif ($format eq 'man') { $out_file = $self->_readme_man($in_file, $out_file, $options); } elsif ($format eq 'pdf') { $out_file = $self->_readme_pdf($in_file, $out_file, $options); } if ($clean) { $self->clean_files($out_file); } return 1; } sub _readme_txt { my ($self, $in_file, $out_file, $options) = @_; $out_file ||= 'README'; require Pod::Text; my $parser = Pod::Text->new( @$options ); open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n"; $parser->output_fh( *$out_fh ); $parser->parse_file( $in_file ); close $out_fh; return $out_file; } sub _readme_htm { my ($self, $in_file, $out_file, $options) = @_; $out_file ||= 'README.htm'; require Pod::Html; Pod::Html::pod2html( "--infile=$in_file", "--outfile=$out_file", @$options, ); # Remove temporary files if needed for my $file ('pod2htmd.tmp', 'pod2htmi.tmp') { if (-e $file) { unlink $file or warn "Warning: Could not remove file '$file'.\n$!\n"; } } return $out_file; } sub _readme_man { my ($self, $in_file, $out_file, $options) = @_; $out_file ||= 'README.1'; require Pod::Man; my $parser = Pod::Man->new( @$options ); $parser->parse_from_file($in_file, $out_file); return $out_file; } sub _readme_pdf { my ($self, $in_file, $out_file, $options) = @_; $out_file ||= 'README.pdf'; eval { require App::pod2pdf; } or die "Could not generate $out_file because pod2pdf could not be found\n"; my $parser = App::pod2pdf->new( @$options ); $parser->parse_from_file($in_file); open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n"; select $out_fh; $parser->output; select STDOUT; close $out_fh; return $out_file; } sub _all_from { my $self = shift; return unless $self->admin->{extensions}; my ($metadata) = grep { ref($_) eq 'Module::Install::Metadata'; } @{$self->admin->{extensions}}; return unless $metadata; return $metadata->{values}{all_from} || ''; } 'Readme!'; __END__ #line 254 ZeroMQ-0.23/inc/Module/Install/TestTarget.pm000644 000765 000024 00000010371 12037235553 021442 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::TestTarget; use 5.006_002; use strict; #use warnings; # XXX: warnings.pm produces a lot of 'redefine' warnings! our $VERSION = '0.19'; use base qw(Module::Install::Base); use Config; use Carp qw(croak); our($ORIG_TEST_VIA_HARNESS); our $TEST_DYNAMIC = { env => '', includes => '', load_modules => '', insert_on_prepare => '', insert_on_finalize => '', run_on_prepare => '', run_on_finalize => '', }; # override the default `make test` sub default_test_target { my ($self, %args) = @_; my %test = _build_command_parts(%args); $TEST_DYNAMIC = \%test; } # create a new test target sub test_target { my ($self, $target, %args) = @_; croak 'target must be spesiced at test_target()' unless $target; my $alias = "\n"; if($args{alias}) { $alias .= qq{$args{alias} :: $target\n\n}; } if($Module::Install::AUTHOR && $args{alias_for_author}) { $alias .= qq{$args{alias_for_author} :: $target\n\n}; } my $test = _assemble(_build_command_parts(%args)); $self->postamble( $alias . qq{$target :: pure_all\n} . qq{\t} . $test ); } sub _build_command_parts { my %args = @_; #XXX: _build_command_parts() will be called first, so we put it here unless(defined $ORIG_TEST_VIA_HARNESS) { $ORIG_TEST_VIA_HARNESS = MY->can('test_via_harness'); no warnings 'redefine'; *MY::test_via_harness = \&_test_via_harness; } for my $key (qw/includes load_modules run_on_prepare run_on_finalize insert_on_prepare insert_on_finalize tests/) { $args{$key} ||= []; $args{$key} = [$args{$key}] unless ref $args{$key} eq 'ARRAY'; } $args{env} ||= {}; my %test; $test{includes} = @{$args{includes}} ? join '', map { qq|"-I$_" | } @{$args{includes}} : ''; $test{load_modules} = @{$args{load_modules}} ? join '', map { qq|"-M$_" | } @{$args{load_modules}} : ''; $test{tests} = @{$args{tests}} ? join '', map { qq|"$_" | } @{$args{tests}} : '$(TEST_FILES)'; for my $key (qw/run_on_prepare run_on_finalize/) { $test{$key} = @{$args{$key}} ? join '', map { qq|do { local \$@; do '$_'; die \$@ if \$@ }; | } @{$args{$key}} : ''; $test{$key} = _quote($test{$key}); } for my $key (qw/insert_on_prepare insert_on_finalize/) { my $codes = join '', map { _build_funcall($_) } @{$args{$key}}; $test{$key} = _quote($codes); } $test{env} = %{$args{env}} ? _quote(join '', map { my $key = _env_quote($_); my $val = _env_quote($args{env}->{$_}); sprintf "\$ENV{q{%s}} = q{%s}; ", $key, $val } keys %{$args{env}}) : ''; return %test; } my $bd; sub _build_funcall { my($code) = @_; if(ref $code eq 'CODE') { $bd ||= do { require B::Deparse; B::Deparse->new() }; $code = $bd->coderef2text($code); } return qq|sub { $code }->(); |; } sub _quote { my $code = shift; $code =~ s/\$/\\\$\$/g; $code =~ s/"/\\"/g; $code =~ s/\n/ /g; if ($^O eq 'MSWin32') { $code =~ s/\\\$\$/\$\$/g; if ($Config{make} =~ /dmake/i) { $code =~ s/{/{{/g; $code =~ s/}/}}/g; } } return $code; } sub _env_quote { my $val = shift; $val =~ s/}/\\}/g; return $val; } sub _assemble { my %args = @_; my $command = MY->$ORIG_TEST_VIA_HARNESS($args{perl} || '$(FULLPERLRUN)', $args{tests}); # inject includes and modules before the first switch $command =~ s/("- \S+? ")/$args{includes}$args{load_modules}$1/xms; # inject snipetts in the one-liner $command =~ s{ ( "-e" \s+ ") # start the one liner ( (?: [^"] | \\ . )+ ) # body of the one liner ( " ) # end the one liner }{ join '', $1, $args{env}, $args{run_on_prepare}, $args{insert_on_prepare}, "$2; ", $args{run_on_finalize}, $args{insert_on_finalize}, $3, }xmse; return $command; } sub _test_via_harness { my($self, $perl, $tests) = @_; $TEST_DYNAMIC->{perl} = $perl; $TEST_DYNAMIC->{tests} ||= $tests; return _assemble(%$TEST_DYNAMIC); } 1; __END__ #line 393 ZeroMQ-0.23/inc/Module/Install/Win32.pm000644 000765 000024 00000003403 12037235553 020254 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; ZeroMQ-0.23/inc/Module/Install/WriteAll.pm000644 000765 000024 00000002376 12037235553 021105 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; ZeroMQ-0.23/inc/Module/Install/XSUtil.pm000644 000765 000024 00000044644 12037235553 020556 0ustar00daisukestaff000000 000000 #line 1 package Module::Install::XSUtil; use 5.005_03; $VERSION = '0.42'; use Module::Install::Base; @ISA = qw(Module::Install::Base); use strict; use Config; use File::Spec; use File::Find; use constant _VERBOSE => $ENV{MI_VERBOSE} ? 1 : 0; my %ConfigureRequires = ( 'ExtUtils::ParseXS' => 2.21, ); my %BuildRequires = ( ); my %Requires = ( 'XSLoader' => 0.02, ); my %ToInstall; my $UseC99 = 0; my $UseCplusplus = 0; sub _verbose{ print STDERR q{# }, @_, "\n"; } sub _xs_debugging{ return $ENV{XS_DEBUG} || scalar( grep{ $_ eq '-g' } @ARGV ); } sub _xs_initialize{ my($self) = @_; unless($self->{xsu_initialized}){ $self->{xsu_initialized} = 1; if(!$self->cc_available()){ warn "This distribution requires a C compiler, but it's not available, stopped.\n"; exit; } $self->configure_requires(%ConfigureRequires); $self->build_requires(%BuildRequires); $self->requires(%Requires); $self->makemaker_args->{OBJECT} = '$(O_FILES)'; $self->clean_files('$(O_FILES)'); $self->clean_files('*.stackdump') if $^O eq 'cygwin'; if($self->_xs_debugging()){ # override $Config{optimize} if(_is_msvc()){ $self->makemaker_args->{OPTIMIZE} = '-Zi'; } else{ $self->makemaker_args->{OPTIMIZE} = '-g -ggdb -g3'; } $self->cc_define('-DXS_ASSERT'); } } return; } # GNU C Compiler sub _is_gcc{ return $Config{gccversion}; } # Microsoft Visual C++ Compiler (cl.exe) sub _is_msvc{ return $Config{cc} =~ /\A cl \b /xmsi; } { my $cc_available; sub cc_available { return defined $cc_available ? $cc_available : ($cc_available = shift->can_cc()) ; } my $want_xs; sub want_xs { my($self, $default) = @_; return $want_xs if defined $want_xs; # you're using this module, you must want XS by default # unless PERL_ONLY is true. $default = !$ENV{PERL_ONLY} if not defined $default; foreach my $arg(@ARGV){ if($arg eq '--pp'){ return $want_xs = 0; } elsif($arg eq '--xs'){ return $want_xs = 1; } } return $want_xs = $default; } } sub use_ppport{ my($self, $dppp_version) = @_; return if $self->{_ppport_ok}++; $self->_xs_initialize(); my $filename = 'ppport.h'; $dppp_version ||= 3.19; # the more, the better $self->configure_requires('Devel::PPPort' => $dppp_version); $self->build_requires('Devel::PPPort' => $dppp_version); print "Writing $filename\n"; my $e = do{ local $@; eval qq{ use Devel::PPPort; Devel::PPPort::WriteFile(q{$filename}); }; $@; }; if($e){ print "Cannot create $filename because: $@\n"; } if(-e $filename){ $self->clean_files($filename); $self->cc_define('-DUSE_PPPORT'); $self->cc_append_to_inc('.'); } return; } sub use_xshelper { my($self, $opt) = @_; $self->_xs_initialize(); $self->use_ppport(); my $file = 'xshelper.h'; open my $fh, '>', $file or die "Cannot open $file for writing: $!"; print $fh $self->_xshelper_h(); close $fh or die "Cannot close $file: $!"; if(defined $opt) { if($opt eq '-clean') { $self->clean_files($file); } else { $self->realclean_files($file); } } return; } sub _gccversion { my $res = `$Config{cc} --version`; my ($version) = $res =~ /\(GCC\) ([0-9.]+)/; no warnings 'numeric', 'uninitialized'; return sprintf '%g', $version; } sub cc_warnings{ my($self) = @_; $self->_xs_initialize(); if(_is_gcc()){ $self->cc_append_to_ccflags(qw(-Wall)); my $gccversion = _gccversion(); if($gccversion >= 4.0){ $self->cc_append_to_ccflags(qw(-Wextra)); if(!($UseC99 or $UseCplusplus)) { # Note: MSVC++ doesn't support C99, # so -Wdeclaration-after-statement helps # ensure C89 specs. $self->cc_append_to_ccflags(qw(-Wdeclaration-after-statement)); } if($gccversion >= 4.1 && !$UseCplusplus) { $self->cc_append_to_ccflags(qw(-Wc++-compat)); } } else{ $self->cc_append_to_ccflags(qw(-W -Wno-comment)); } } elsif(_is_msvc()){ $self->cc_append_to_ccflags(qw(-W3)); } else{ # TODO: support other compilers } return; } sub c99_available { my($self) = @_; return 0 if not $self->cc_available(); require File::Temp; require File::Basename; my $tmpfile = File::Temp->new(SUFFIX => '.c'); $tmpfile->print(<<'C99'); // include a C99 header #include inline // a C99 keyword with C99 style comments int test_c99() { int i = 0; i++; int j = i - 1; // another C99 feature: declaration after statement return j; } C99 $tmpfile->close(); system "$Config{cc} -c " . $tmpfile->filename; (my $objname = File::Basename::basename($tmpfile->filename)) =~ s/\Q.c\E$/$Config{_o}/; unlink $objname or warn "Cannot unlink $objname (ignored): $!"; return $? == 0; } sub requires_c99 { my($self) = @_; if(!$self->c99_available) { warn "This distribution requires a C99 compiler, but $Config{cc} seems not to support C99, stopped.\n"; exit; } $self->_xs_initialize(); $UseC99 = 1; return; } sub requires_cplusplus { my($self) = @_; if(!$self->cc_available) { warn "This distribution requires a C++ compiler, but $Config{cc} seems not to support C++, stopped.\n"; exit; } $self->_xs_initialize(); $UseCplusplus = 1; return; } sub cc_append_to_inc{ my($self, @dirs) = @_; $self->_xs_initialize(); for my $dir(@dirs){ unless(-d $dir){ warn("'$dir' not found: $!\n"); } _verbose "inc: -I$dir" if _VERBOSE; } my $mm = $self->makemaker_args; my $paths = join q{ }, map{ s{\\}{\\\\}g; qq{"-I$_"} } @dirs; if($mm->{INC}){ $mm->{INC} .= q{ } . $paths; } else{ $mm->{INC} = $paths; } return; } sub cc_libs { my ($self, @libs) = @_; @libs = map{ my($name, $dir) = ref($_) eq 'ARRAY' ? @{$_} : ($_, undef); my $lib; if(defined $dir) { $lib = ($dir =~ /^-/ ? qq{$dir } : qq{-L$dir }); } else { $lib = ''; } $lib .= ($name =~ /^-/ ? qq{$name} : qq{-l$name}); _verbose "libs: $lib" if _VERBOSE; $lib; } @libs; $self->cc_append_to_libs( @libs ); } sub cc_append_to_libs{ my($self, @libs) = @_; $self->_xs_initialize(); return unless @libs; my $libs = join q{ }, @libs; my $mm = $self->makemaker_args; if ($mm->{LIBS}){ $mm->{LIBS} .= q{ } . $libs; } else{ $mm->{LIBS} = $libs; } return $libs; } sub cc_assert_lib { my ($self, @dcl_args) = @_; if ( ! $self->{xsu_loaded_checklib} ) { my $loaded_lib = 0; foreach my $checklib (qw(inc::Devel::CheckLib Devel::CheckLib)) { eval "use $checklib 0.4"; if (!$@) { $loaded_lib = 1; last; } } if (! $loaded_lib) { warn "Devel::CheckLib not found in inc/ nor \@INC"; exit 0; } $self->{xsu_loaded_checklib}++; $self->configure_requires( "Devel::CheckLib" => "0.4" ); $self->build_requires( "Devel::CheckLib" => "0.4" ); } Devel::CheckLib::check_lib_or_exit(@dcl_args); } sub cc_append_to_ccflags{ my($self, @ccflags) = @_; $self->_xs_initialize(); my $mm = $self->makemaker_args; $mm->{CCFLAGS} ||= $Config{ccflags}; $mm->{CCFLAGS} .= q{ } . join q{ }, @ccflags; return; } sub cc_define{ my($self, @defines) = @_; $self->_xs_initialize(); my $mm = $self->makemaker_args; if(exists $mm->{DEFINE}){ $mm->{DEFINE} .= q{ } . join q{ }, @defines; } else{ $mm->{DEFINE} = join q{ }, @defines; } return; } sub requires_xs{ my $self = shift; return $self->requires() unless @_; $self->_xs_initialize(); my %added = $self->requires(@_); my(@inc, @libs); my $rx_lib = qr{ \. (?: lib | a) \z}xmsi; my $rx_dll = qr{ \. dll \z}xmsi; # for Cygwin while(my $module = each %added){ my $mod_basedir = File::Spec->join(split /::/, $module); my $rx_header = qr{\A ( .+ \Q$mod_basedir\E ) .+ \. h(?:pp)? \z}xmsi; SCAN_INC: foreach my $inc_dir(@INC){ my @dirs = grep{ -e } File::Spec->join($inc_dir, 'auto', $mod_basedir), File::Spec->join($inc_dir, $mod_basedir); next SCAN_INC unless @dirs; my $n_inc = scalar @inc; find(sub{ if(my($incdir) = $File::Find::name =~ $rx_header){ push @inc, $incdir; } elsif($File::Find::name =~ $rx_lib){ my($libname) = $_ =~ /\A (?:lib)? (\w+) /xmsi; push @libs, [$libname, $File::Find::dir]; } elsif($File::Find::name =~ $rx_dll){ # XXX: hack for Cygwin my $mm = $self->makemaker_args; $mm->{macro}->{PERL_ARCHIVE_AFTER} ||= ''; $mm->{macro}->{PERL_ARCHIVE_AFTER} .= ' ' . $File::Find::name; } }, @dirs); if($n_inc != scalar @inc){ last SCAN_INC; } } } my %uniq = (); $self->cc_append_to_inc (grep{ !$uniq{ $_ }++ } @inc); %uniq = (); $self->cc_libs(grep{ !$uniq{ $_->[0] }++ } @libs); return %added; } sub cc_src_paths{ my($self, @dirs) = @_; $self->_xs_initialize(); return unless @dirs; my $mm = $self->makemaker_args; my $XS_ref = $mm->{XS} ||= {}; my $C_ref = $mm->{C} ||= []; my $_obj = $Config{_o}; my @src_files; find(sub{ if(/ \. (?: xs | c (?: c | pp | xx )? ) \z/xmsi){ # *.{xs, c, cc, cpp, cxx} push @src_files, $File::Find::name; } }, @dirs); my $xs_to = $UseCplusplus ? '.cpp' : '.c'; foreach my $src_file(@src_files){ my $c = $src_file; if($c =~ s/ \.xs \z/$xs_to/xms){ $XS_ref->{$src_file} = $c; _verbose "xs: $src_file" if _VERBOSE; } else{ _verbose "c: $c" if _VERBOSE; } push @{$C_ref}, $c unless grep{ $_ eq $c } @{$C_ref}; } $self->clean_files(map{ File::Spec->catfile($_, '*.gcov'), File::Spec->catfile($_, '*.gcda'), File::Spec->catfile($_, '*.gcno'), } @dirs); $self->cc_append_to_inc('.'); return; } sub cc_include_paths{ my($self, @dirs) = @_; $self->_xs_initialize(); push @{ $self->{xsu_include_paths} ||= []}, @dirs; my $h_map = $self->{xsu_header_map} ||= {}; foreach my $dir(@dirs){ my $prefix = quotemeta( File::Spec->catfile($dir, '') ); find(sub{ return unless / \.h(?:pp)? \z/xms; (my $h_file = $File::Find::name) =~ s/ \A $prefix //xms; $h_map->{$h_file} = $File::Find::name; }, $dir); } $self->cc_append_to_inc(@dirs); return; } sub install_headers{ my $self = shift; my $h_files; if(@_ == 0){ $h_files = $self->{xsu_header_map} or die "install_headers: cc_include_paths not specified.\n"; } elsif(@_ == 1 && ref($_[0]) eq 'HASH'){ $h_files = $_[0]; } else{ $h_files = +{ map{ $_ => undef } @_ }; } $self->_xs_initialize(); my @not_found; my $h_map = $self->{xsu_header_map} || {}; while(my($ident, $path) = each %{$h_files}){ $path ||= $h_map->{$ident} || File::Spec->join('.', $ident); $path = File::Spec->canonpath($path); unless($path && -e $path){ push @not_found, $ident; next; } $ToInstall{$path} = File::Spec->join('$(INST_ARCHAUTODIR)', $ident); _verbose "install: $path as $ident" if _VERBOSE; my @funcs = $self->_extract_functions_from_header_file($path); if(@funcs){ $self->cc_append_to_funclist(@funcs); } } if(@not_found){ die "Header file(s) not found: @not_found\n"; } return; } my $home_directory; sub _extract_functions_from_header_file{ my($self, $h_file) = @_; my @functions; ($home_directory) = <~> unless defined $home_directory; # get header file contents through cpp(1) my $contents = do { my $mm = $self->makemaker_args; my $cppflags = q{"-I}. File::Spec->join($Config{archlib}, 'CORE') . q{"}; $cppflags =~ s/~/$home_directory/g; $cppflags .= ' ' . $mm->{INC} if $mm->{INC}; $cppflags .= ' ' . ($mm->{CCFLAGS} || $Config{ccflags}); $cppflags .= ' ' . $mm->{DEFINE} if $mm->{DEFINE}; my $add_include = _is_msvc() ? '-FI' : '-include'; $cppflags .= ' ' . join ' ', map{ qq{$add_include "$_"} } qw(EXTERN.h perl.h XSUB.h); my $cppcmd = qq{$Config{cpprun} $cppflags $h_file}; # remove all the -arch options to workaround gcc errors: # "-E, -S, -save-temps and -M options are not allowed # with multiple -arch flags" $cppcmd =~ s/ -arch \s* \S+ //xmsg; _verbose("extract functions from: $cppcmd") if _VERBOSE; `$cppcmd`; }; unless(defined $contents){ die "Cannot call C pre-processor ($Config{cpprun}): $! ($?)"; } # remove other include file contents my $chfile = q/\# (?:line)? \s+ \d+ /; $contents =~ s{ ^$chfile \s+ (?!"\Q$h_file\E") .*? ^(?= $chfile) }{}xmsig; if(_VERBOSE){ local *H; open H, "> $h_file.out" and print H $contents and close H; } while($contents =~ m{ ([^\\;\s]+ # type \s+ ([a-zA-Z_][a-zA-Z0-9_]*) # function name \s* \( [^;#]* \) # argument list [\w\s\(\)]* # attributes or something ;) # end of declaration }xmsg){ my $decl = $1; my $name = $2; next if $decl =~ /\b typedef \b/xms; next if $name =~ /^_/xms; # skip something private push @functions, $name; if(_VERBOSE){ $decl =~ tr/\n\r\t / /s; $decl =~ s/ (\Q$name\E) /<$name>/xms; _verbose("decl: $decl"); } } return @functions; } sub cc_append_to_funclist{ my($self, @functions) = @_; $self->_xs_initialize(); my $mm = $self->makemaker_args; push @{$mm->{FUNCLIST} ||= []}, @functions; $mm->{DL_FUNCS} ||= { '$(NAME)' => [] }; return; } sub _xshelper_h { my $h = <<'XSHELPER_H'; :/* THIS FILE IS AUTOMATICALLY GENERATED BY Module::Install::XSUtil $VERSION. */ :/* :=head1 NAME : :xshelper.h - Helper C header file for XS modules : :=head1 DESCRIPTION : : // This includes all the perl header files and ppport.h : #include "xshelper.h" : :=head1 SEE ALSO : :L, where this file is distributed as a part of : :=head1 AUTHOR : :Fuji, Goro (gfx) Egfuji at cpan.orgE : :=head1 LISENCE : :Copyright (c) 2010, Fuji, Goro (gfx). All rights reserved. : :This library is free software; you can redistribute it and/or modify :it under the same terms as Perl itself. : :=cut :*/ : :#ifdef __cplusplus :extern "C" { :#endif : :#define PERL_NO_GET_CONTEXT /* we want efficiency */ :#include :#include :#define NO_XSLOCKS /* for exceptions */ :#include : :#ifdef __cplusplus :} /* extern "C" */ :#endif : :#include "ppport.h" : :/* portability stuff not supported by ppport.h yet */ : :#ifndef STATIC_INLINE /* from 5.13.4 */ :# if defined(__GNUC__) || defined(__cplusplus) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901L)) :# define STATIC_INLINE static inline :# else :# define STATIC_INLINE static :# endif :#endif /* STATIC_INLINE */ : :#ifndef __attribute__format__ :#define __attribute__format__(a,b,c) /* nothing */ :#endif : :#ifndef LIKELY /* they are just a compiler's hint */ :#define LIKELY(x) (!!(x)) :#define UNLIKELY(x) (!!(x)) :#endif : :#ifndef newSVpvs_share :#define newSVpvs_share(s) Perl_newSVpvn_share(aTHX_ STR_WITH_LEN(s), 0U) :#endif : :#ifndef get_cvs :#define get_cvs(name, flags) get_cv(name, flags) :#endif : :#ifndef GvNAME_get :#define GvNAME_get GvNAME :#endif :#ifndef GvNAMELEN_get :#define GvNAMELEN_get GvNAMELEN :#endif : :#ifndef CvGV_set :#define CvGV_set(cv, gv) (CvGV(cv) = (gv)) :#endif : :/* general utility */ : :#if PERL_BCDVERSION >= 0x5008005 :#define LooksLikeNumber(x) looks_like_number(x) :#else :#define LooksLikeNumber(x) (SvPOKp(x) ? looks_like_number(x) : (I32)SvNIOKp(x)) :#endif : :#define newAV_mortal() (AV*)sv_2mortal((SV*)newAV()) :#define newHV_mortal() (HV*)sv_2mortal((SV*)newHV()) :#define newRV_inc_mortal(sv) sv_2mortal(newRV_inc(sv)) :#define newRV_noinc_mortal(sv) sv_2mortal(newRV_noinc(sv)) : :#define DECL_BOOT(name) EXTERN_C XS(CAT2(boot_, name)) :#define CALL_BOOT(name) STMT_START { \ : PUSHMARK(SP); \ : CALL_FPTR(CAT2(boot_, name))(aTHX_ cv); \ : } STMT_END XSHELPER_H $h =~ s/^://xmsg; $h =~ s/\$VERSION\b/$Module::Install::XSUtil::VERSION/xms; return $h; } package MY; # XXX: We must append to PM inside ExtUtils::MakeMaker->new(). sub init_PM { my $self = shift; $self->SUPER::init_PM(@_); while(my($k, $v) = each %ToInstall){ $self->{PM}{$k} = $v; } return; } # append object file names to CCCMD sub const_cccmd { my $self = shift; my $cccmd = $self->SUPER::const_cccmd(@_); return q{} unless $cccmd; if (Module::Install::XSUtil::_is_msvc()){ $cccmd .= ' -Fo$@'; } else { $cccmd .= ' -o $@'; } return $cccmd } sub xs_c { my($self) = @_; my $mm = $self->SUPER::xs_c(); $mm =~ s/ \.c /.cpp/xmsg if $UseCplusplus; return $mm; } sub xs_o { my($self) = @_; my $mm = $self->SUPER::xs_o(); $mm =~ s/ \.c /.cpp/xmsg if $UseCplusplus; return $mm; } 1; __END__ #line 1025 ZeroMQ-0.23/inc/Devel/CheckLib.pm000644 000765 000024 00000035303 12037235553 017226 0ustar00daisukestaff000000 000000 # $Id: CheckLib.pm,v 1.25 2008/10/27 12:16:23 drhyde Exp $ package # Devel::CheckLib; use 5.00405; #postfix foreach use strict; use vars qw($VERSION @ISA @EXPORT); $VERSION = '0.98'; use Config qw(%Config); use Text::ParseWords 'quotewords'; use File::Spec; use File::Temp; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(assert_lib check_lib_or_exit check_lib); # localising prevents the warningness leaking out of this module local $^W = 1; # use warnings is a 5.6-ism _findcc(); # bomb out early if there's no compiler =head1 NAME Devel::CheckLib - check that a library is available =head1 DESCRIPTION Devel::CheckLib is a perl module that checks whether a particular C library and its headers are available. =head1 SYNOPSIS use Devel::CheckLib; check_lib_or_exit( lib => 'jpeg', header => 'jpeglib.h' ); check_lib_or_exit( lib => [ 'iconv', 'jpeg' ] ); # or prompt for path to library and then do this: check_lib_or_exit( lib => 'jpeg', libpath => $additional_path ); =head1 USING IT IN Makefile.PL or Build.PL If you want to use this from Makefile.PL or Build.PL, do not simply copy the module into your distribution as this may cause problems when PAUSE and search.cpan.org index the distro. Instead, use the use-devel-checklib script. =head1 HOW IT WORKS You pass named parameters to a function, describing to it how to build and link to the libraries. It works by trying to compile some code - which defaults to this: int main(void) { return 0; } and linking it to the specified libraries. If something pops out the end which looks executable, it gets executed, and if main() returns 0 we know that it worked. That tiny program is built once for each library that you specify, and (without linking) once for each header file. If you want to check for the presence of particular functions in a library, or even that those functions return particular results, then you can pass your own function body for main() thus: check_lib_or_exit( function => 'foo();if(libversion() > 5) return 0; else return 1;' incpath => ... libpath => ... lib => ... header => ... ); In that case, it will fail to build if either foo() or libversion() don't exist, and main() will return the wrong value if libversion()'s return value isn't what you want. =head1 FUNCTIONS All of these take the same named parameters and are exported by default. To avoid exporting them, C. =head2 assert_lib This takes several named parameters, all of which are optional, and dies with an error message if any of the libraries listed can not be found. B: dying in a Makefile.PL or Build.PL may provoke a 'FAIL' report from CPAN Testers' automated smoke testers. Use C instead. The named parameters are: =over =item lib Must be either a string with the name of a single library or a reference to an array of strings of library names. Depending on the compiler found, library names will be fed to the compiler either as C<-l> arguments or as C<.lib> file names. (E.g. C<-ljpeg> or C) =item libpath a string or an array of strings representing additional paths to search for libraries. =item LIBS a C-style space-seperated list of libraries (each preceded by '-l') and directories (preceded by '-L'). This can also be supplied on the command-line. =back And libraries are no use without header files, so ... =over =item header Must be either a string with the name of a single header file or a reference to an array of strings of header file names. =item incpath a string or an array of strings representing additional paths to search for headers. =item INC a C-style space-seperated list of incpaths, each preceded by '-I'. This can also be supplied on the command-line. =back =head2 check_lib_or_exit This behaves exactly the same as C except that instead of dieing, it warns (with exactly the same error message) and exits. This is intended for use in Makefile.PL / Build.PL when you might want to prompt the user for various paths and things before checking that what they've told you is sane. If any library or header is missing, it exits with an exit value of 0 to avoid causing a CPAN Testers 'FAIL' report. CPAN Testers should ignore this result -- which is what you want if an external library dependency is not available. =head2 check_lib This behaves exactly the same as C except that it is silent, returning false instead of dieing, or true otherwise. =cut sub check_lib_or_exit { eval 'assert_lib(@_)'; if($@) { warn $@; exit; } } sub check_lib { eval 'assert_lib(@_)'; return $@ ? 0 : 1; } sub assert_lib { my %args = @_; my (@libs, @libpaths, @headers, @incpaths); # FIXME: these four just SCREAM "refactor" at me @libs = (ref($args{lib}) ? @{$args{lib}} : $args{lib}) if $args{lib}; @libpaths = (ref($args{libpath}) ? @{$args{libpath}} : $args{libpath}) if $args{libpath}; @headers = (ref($args{header}) ? @{$args{header}} : $args{header}) if $args{header}; @incpaths = (ref($args{incpath}) ? @{$args{incpath}} : $args{incpath}) if $args{incpath}; # work-a-like for Makefile.PL's LIBS and INC arguments # if given as command-line argument, append to %args for my $arg (@ARGV) { for my $mm_attr_key (qw(LIBS INC)) { if (my ($mm_attr_value) = $arg =~ /\A $mm_attr_key = (.*)/x) { # it is tempting to put some \s* into the expression, but the # MM command-line parser only accepts LIBS etc. followed by =, # so we should not be any more lenient with whitespace than that $args{$mm_attr_key} .= " $mm_attr_value"; } } } # using special form of split to trim whitespace if(defined($args{LIBS})) { foreach my $arg (split(' ', $args{LIBS})) { die("LIBS argument badly-formed: $arg\n") unless($arg =~ /^-l/i); push @{$arg =~ /^-l/ ? \@libs : \@libpaths}, substr($arg, 2); } } if(defined($args{INC})) { foreach my $arg (split(' ', $args{INC})) { die("INC argument badly-formed: $arg\n") unless($arg =~ /^-I/); push @incpaths, substr($arg, 2); } } my ($cc, $ld) = _findcc(); my @missing; my @wrongresult; my @use_headers; # first figure out which headers we can't find ... for my $header (@headers) { push @use_headers, $header; my($ch, $cfile) = File::Temp::tempfile( 'assertlibXXXXXXXX', SUFFIX => '.c' ); my $ofile = $cfile; $ofile =~ s/\.c$/$Config{_o}/; print $ch qq{#include <$_>\n} for @use_headers; print $ch qq{int main(void) { return 0; }\n}; close($ch); my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe}; my @sys_cmd; # FIXME: re-factor - almost identical code later when linking if ( $Config{cc} eq 'cl' ) { # Microsoft compiler require Win32; @sys_cmd = ( @$cc, $cfile, "/Fe$exefile", (map { '/I'.Win32::GetShortPathName($_) } @incpaths), "/link", @$ld ); } elsif($Config{cc} =~ /bcc32(\.exe)?/) { # Borland @sys_cmd = ( @$cc, @$ld, (map { "-I$_" } @incpaths), "-o$exefile", $cfile ); } else { # Unix-ish: gcc, Sun, AIX (gcc, cc), ... @sys_cmd = ( @$cc, @$ld, $cfile, (map { "-I$_" } @incpaths), "-o", "$exefile" ); } warn "# @sys_cmd\n" if $args{debug}; my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd); push @missing, $header if $rv != 0 || ! -x $exefile; _cleanup_exe($exefile); unlink $ofile if -e $ofile; unlink $cfile; } # now do each library in turn with headers my($ch, $cfile) = File::Temp::tempfile( 'assertlibXXXXXXXX', SUFFIX => '.c' ); my $ofile = $cfile; $ofile =~ s/\.c$/$Config{_o}/; print $ch qq{#include <$_>\n} foreach (@headers); print $ch "int main(void) { ".($args{function} || 'return 0;')." }\n"; close($ch); for my $lib ( @libs ) { my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe}; my @sys_cmd; if ( $Config{cc} eq 'cl' ) { # Microsoft compiler require Win32; my @libpath = map { q{/libpath:} . Win32::GetShortPathName($_) } @libpaths; # this is horribly sensitive to the order of arguments @sys_cmd = ( @$cc, $cfile, "${lib}.lib", "/Fe$exefile", (map { '/I'.Win32::GetShortPathName($_) } @incpaths), "/link", @$ld, (map {'/libpath:'.Win32::GetShortPathName($_)} @libpaths), ); } elsif($Config{cc} eq 'CC/DECC') { # VMS } elsif($Config{cc} =~ /bcc32(\.exe)?/) { # Borland @sys_cmd = ( @$cc, @$ld, "-o$exefile", (map { "-I$_" } @incpaths), (map { "-L$_" } @libpaths), "-l$lib", $cfile); } else { # Unix-ish # gcc, Sun, AIX (gcc, cc) @sys_cmd = ( @$cc, @$ld, $cfile, "-o", "$exefile", (map { "-I$_" } @incpaths), (map { "-L$_" } @libpaths), "-l$lib", ); } warn "# @sys_cmd\n" if $args{debug}; my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd); push @missing, $lib if $rv != 0 || ! -x $exefile; my $absexefile = File::Spec->rel2abs($exefile); $absexefile = '"'.$absexefile.'"' if $absexefile =~ m/\s/; push @wrongresult, $lib if $rv == 0 && -x $exefile && system($absexefile) != 0; unlink $ofile if -e $ofile; _cleanup_exe($exefile); } unlink $cfile; my $miss_string = join( q{, }, map { qq{'$_'} } @missing ); die("Can't link/include C library $miss_string, aborting.\n") if @missing; my $wrong_string = join( q{, }, map { qq{'$_'} } @wrongresult); die("wrong result: $wrong_string\n") if @wrongresult; } sub _cleanup_exe { my ($exefile) = @_; my $ofile = $exefile; $ofile =~ s/$Config{_exe}$/$Config{_o}/; unlink $exefile if -f $exefile; unlink $ofile if -f $ofile; unlink "$exefile\.manifest" if -f "$exefile\.manifest"; if ( $Config{cc} eq 'cl' ) { # MSVC also creates foo.ilk and foo.pdb my $ilkfile = $exefile; $ilkfile =~ s/$Config{_exe}$/.ilk/; my $pdbfile = $exefile; $pdbfile =~ s/$Config{_exe}$/.pdb/; unlink $ilkfile if -f $ilkfile; unlink $pdbfile if -f $pdbfile; } return } # return ($cc, $ld) # where $cc is an array ref of compiler name, compiler flags # where $ld is an array ref of linker flags sub _findcc { # Need to use $keep=1 to work with MSWin32 backslashes and quotes my $Config_ccflags = $Config{ccflags}; # use copy so ASPerl will compile my @Config_ldflags = (); for my $config_val ( @Config{qw(ldflags perllibs)} ){ push @Config_ldflags, $config_val if ( $config_val =~ /\S/ ); } my @ccflags = grep { length } quotewords('\s+', 1, $Config_ccflags||''); my @ldflags = grep { length } quotewords('\s+', 1, @Config_ldflags); my @paths = split(/$Config{path_sep}/, $ENV{PATH}); my @cc = split(/\s+/, $Config{cc}); return ( [ @cc, @ccflags ], \@ldflags ) if -x $cc[0]; foreach my $path (@paths) { my $compiler = File::Spec->catfile($path, $cc[0]) . $Config{_exe}; return ([ $compiler, @cc[1 .. $#cc], @ccflags ], \@ldflags) if -x $compiler; } die("Couldn't find your C compiler\n"); } # code substantially borrowed from IPC::Run3 sub _quiet_system { my (@cmd) = @_; # save handles local *STDOUT_SAVE; local *STDERR_SAVE; open STDOUT_SAVE, ">&STDOUT" or die "CheckLib: $! saving STDOUT"; open STDERR_SAVE, ">&STDERR" or die "CheckLib: $! saving STDERR"; # redirect to nowhere local *DEV_NULL; open DEV_NULL, ">" . File::Spec->devnull or die "CheckLib: $! opening handle to null device"; open STDOUT, ">&" . fileno DEV_NULL or die "CheckLib: $! redirecting STDOUT to null handle"; open STDERR, ">&" . fileno DEV_NULL or die "CheckLib: $! redirecting STDERR to null handle"; # run system command my $rv = system(@cmd); # restore handles open STDOUT, ">&" . fileno STDOUT_SAVE or die "CheckLib: $! restoring STDOUT handle"; open STDERR, ">&" . fileno STDERR_SAVE or die "CheckLib: $! restoring STDERR handle"; return $rv; } =head1 PLATFORMS SUPPORTED You must have a C compiler installed. We check for C<$Config{cc}>, both literally as it is in Config.pm and also in the $PATH. It has been tested with varying degrees on rigourousness on: =over =item gcc (on Linux, *BSD, Mac OS X, Solaris, Cygwin) =item Sun's compiler tools on Solaris =item IBM's tools on AIX =item SGI's tools on Irix 6.5 =item Microsoft's tools on Windows =item MinGW on Windows (with Strawberry Perl) =item Borland's tools on Windows =item QNX =back =head1 WARNINGS, BUGS and FEEDBACK This is a very early release intended primarily for feedback from people who have discussed it. The interface may change and it has not been adequately tested. Feedback is most welcome, including constructive criticism. Bug reports should be made using L or by email. When submitting a bug report, please include the output from running: perl -V perl -MDevel::CheckLib -e0 =head1 SEE ALSO L L =head1 AUTHORS David Cantrell Edavid@cantrell.org.ukE David Golden Edagolden@cpan.orgE Yasuhiro Matsumoto Emattn@cpan.orgE Thanks to the cpan-testers-discuss mailing list for prompting us to write it in the first place; to Chris Williams for help with Borland support; to Tony Cook for help with Microsoft compiler command-line options =head1 COPYRIGHT and LICENCE Copyright 2007 David Cantrell. Portions copyright 2007 David Golden. This module is free-as-in-speech software, and may be used, distributed, and modified under the same conditions as perl itself. =head1 CONSPIRACY This module is also free-as-in-mason software. =cut 1; ZeroMQ-0.23/eg/hello_client.pl000644 000765 000024 00000000757 12037235040 017001 0ustar00daisukestaff000000 000000 #!/usr/bin/env perl use strict; use ZeroMQ qw(ZMQ_REQ); my ($host, $port); if (@ARGV >= 2) { ($host, $port) = @ARGV; } elsif (@ARGV) { if ($ARGV[0] =~ /^([\w\.]+):(\d+)$/) { ($host, $port) = ($1, $2); } else { $host = $ARGV[0]; } } $host ||= '127.0.0.1'; $port ||= 5566; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_REQ); $sock->connect( "tcp://$host:$port" ); $sock->send("hello"); my $message = $sock->recv(); print $message->data, "\n";ZeroMQ-0.23/eg/hello_server.pl000644 000765 000024 00000001005 12037235040 017014 0ustar00daisukestaff000000 000000 #!/usr/bin/env perl use strict; use ZeroMQ qw(ZMQ_REP); my ($host, $port); if (@ARGV >= 2) { ($host, $port) = @ARGV; } elsif (@ARGV) { if ($ARGV[0] =~ /^([\w\.]+):(\d+)$/) { ($host, $port) = ($1, $2); } else { $host = $ARGV[0]; } } $host ||= '127.0.0.1'; $port ||= 5566; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_REP); $sock->bind( "tcp://$host:$port" ); while (1) { my $message = $sock->recv(); print $message->data, "\n"; $sock->send("world"); }ZeroMQ-0.23/eg/local_lat.pl000644 000765 000024 00000001035 12037235040 016260 0ustar00daisukestaff000000 000000 use strict; use warnings; use ZeroMQ qw/:all/; if (@ARGV != 3) { die < HERE } my $addr = shift @ARGV; my $msg_size = shift @ARGV; my $roundtrip_count = shift @ARGV; my $cxt = ZeroMQ::Context->new(1); my $sock = ZeroMQ::Socket->new($cxt, ZMQ_REP); $sock->bind($addr); my $msg; foreach (1..$roundtrip_count) { #warn "$_\n" if (not $_ % 1000); $msg = $sock->recv(); die "Bad size" if $msg->size() != $msg_size; $sock->send($msg); } sleep 1; ZeroMQ-0.23/eg/pubsub_client.pl000644 000765 000024 00000001043 12037235040 017163 0ustar00daisukestaff000000 000000 #!/usr/bin/env perl use strict; use ZeroMQ qw(ZMQ_SUB ZMQ_SUBSCRIBE); my ($host, $port); if (@ARGV >= 2) { ($host, $port) = @ARGV; } elsif (@ARGV) { if ($ARGV[0] =~ /^([\w\.]+):(\d+)$/) { ($host, $port) = ($1, $2); } else { $host = $ARGV[0]; } } $host ||= '127.0.0.1'; $port ||= 5566; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_SUB); $sock->connect( "tcp://$host:$port" ); $sock->setsockopt(ZMQ_SUBSCRIBE, "H"); while (1) { my $message = $sock->recv(); print $message->data, "\n"; }ZeroMQ-0.23/eg/pubsub_server.pl000644 000765 000024 00000001030 12037235040 017207 0ustar00daisukestaff000000 000000 #!/usr/bin/env perl use strict; use ZeroMQ qw(ZMQ_PUB); my ($host, $port); if (@ARGV >= 2) { ($host, $port) = @ARGV; } elsif (@ARGV) { if ($ARGV[0] =~ /^([\w\.]+):(\d+)$/) { ($host, $port) = ($1, $2); } else { $host = $ARGV[0]; } } $host ||= '127.0.0.1'; $port ||= 5566; my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_PUB); $sock->bind( "tcp://$host:$port" ); my $count = 0; while (1) { $count++; $sock->send("HELLO? $count"); $sock->send("WORLD? $count"); sleep 2; }ZeroMQ-0.23/eg/remote_lat.pl000644 000765 000024 00000001551 12037235040 016464 0ustar00daisukestaff000000 000000 use strict; use warnings; use ZeroMQ qw/:all/; use Time::HiRes qw/time/; if (@ARGV != 3) { die < HERE } my $addr = shift @ARGV; my $msg_size = shift @ARGV; my $roundtrip_count = shift @ARGV; my $cxt = ZeroMQ::Context->new(1); my $sock = ZeroMQ::Socket->new($cxt, ZMQ_REQ); $sock->connect($addr); my $text = '0' x $msg_size; my $msg = ZeroMQ::Message->new($text); my $before = time(); foreach (1..$roundtrip_count) { #warn "$_\n" if (not $_ % 1000); $sock->send($msg); $msg = $sock->recv(); die "Bad size" if $msg->size() != $msg_size; } my $after = time(); my $latency = ($after-$before) / ($roundtrip_count * 2) * 1.e6; printf("message size: %d [B]\n", $msg_size); printf("roundtrip count: %d\n", $roundtrip_count); printf("average latency: %.3f [us]\n", $latency); ZeroMQ-0.23/eg/thread_0mq.pl000644 000765 000024 00000003056 12037235040 016357 0ustar00daisukestaff000000 000000 use strict; use warnings; use Config; use Time::HiRes qw/sleep time/; use ZeroMQ qw/:all/; BEGIN { if ( $Config{useithreads} ) { # We have threads require threads; } else { die 'Need threads to test '; } } if (@ARGV != 3) { die < HERE } my $addr = shift @ARGV; my $msg_size = shift @ARGV; my $roundtrip_count = shift @ARGV; my $local_thr = threads->create( \&local ); sub local { my $cxt = ZeroMQ::Context->new(1); my $sock = ZeroMQ::Socket->new( $cxt, ZMQ_REP ); print "[local] Trying to start at $addr \n"; $sock->bind($addr); my $msg; foreach ( 1 .. $roundtrip_count ) { #warn "$_\n" if (not $_ % 1000); $msg = $sock->recv(); die "Bad size" if $msg->size() != $msg_size; $sock->send($msg); } } sleep 0.1; my $remote_thr = threads->create( \&remote ); sub remote { my $cxt = ZeroMQ::Context->new(1); my $sock = ZeroMQ::Socket->new( $cxt, ZMQ_REQ ); print "[remote] Trying to start at $addr \n"; $sock->connect($addr); my $text = '0' x $msg_size; my $msg = ZeroMQ::Message->new($text); my $before = time(); foreach ( 1 .. $roundtrip_count ) { #warn "$_\n" if (not $_ % 1000); $sock->send($msg); $msg = $sock->recv(); die "Bad size" if $msg->size() != $msg_size; } my $after = time(); my $latency = ($after - $before) / ( $roundtrip_count * 2 ) * 1.e6; print "Latency: $latency us\n"; } END { $local_thr->join() if defined $local_thr; $remote_thr->join() if defined $remote_thr; } ZeroMQ-0.23/eg/threaded_client.pl000644 000765 000024 00000001061 12037235040 017443 0ustar00daisukestaff000000 000000 #!/usr/bin/env perl use strict; use ZeroMQ qw(ZMQ_REQ); my $ctxt = ZeroMQ::Context->new(); my $sock = $ctxt->socket(ZMQ_REQ); my ($host, $port); if (@ARGV >= 2) { ($host, $port) = @ARGV; } elsif (@ARGV) { if ($ARGV[0] =~ /^([\w\.]+):(\d+)$/) { ($host, $port) = ($1, $2); } else { $host = $ARGV[0]; } } $host ||= '127.0.0.1'; $port ||= 5566; print "Connecting to server...\n"; $sock->connect( "tcp://$host:$port" ); for (1..10) { $sock->send("Hello $$"); my $message = $sock->recv(); print $message->data, "\n"; }ZeroMQ-0.23/eg/threaded_server.pl000644 000765 000024 00000002053 12037235040 017475 0ustar00daisukestaff000000 000000 #!/usr/bin/env perl use strict; use threads; use ZeroMQ::Constants qw(ZMQ_XREQ ZMQ_XREP ZMQ_REQ ZMQ_REP ZMQ_QUEUE); use ZeroMQ::Raw; my $ctxt = zmq_init(); my $clients = zmq_socket($ctxt, ZMQ_XREP); my $workers = zmq_socket($ctxt, ZMQ_XREQ); my ($host, $port); if (@ARGV >= 2) { ($host, $port) = @ARGV; } elsif (@ARGV) { if ($ARGV[0] =~ /^([\w\.]+):(\d+)$/) { ($host, $port) = ($1, $2); } else { $host = $ARGV[0]; } } $host ||= '127.0.0.1'; $port ||= 5566; print "Connecting to server...\n"; zmq_bind( $clients, "tcp://$host:$port" ); zmq_bind( $workers, "inproc://workers" ); for (1..5) { threads->create( sub { my $ctxt = shift; my $wsock = zmq_socket($ctxt, ZMQ_REP); zmq_connect( $wsock, "inproc://workers" ); while (1) { my $message = zmq_recv( $wsock ); print zmq_msg_data($message), "\n"; sleep 1; # Do some dummy "work" zmq_send( $wsock, "World" ); } }, $ctxt ); } ZeroMQ::Raw::zmq_device(ZMQ_QUEUE, $clients, $workers);