Commit 84edf252 authored by Michael Gray's avatar Michael Gray
Browse files

ZeroMQ context singleton.

parent eae1735e
......@@ -61,6 +61,7 @@ Reads from STDIN, writes to STDOUT.\n" unless 2 == @ARGV;
warn "Entering MainLoop (pid=$$).\n";
MainLoop();
warn "MainLoop finished (pid=$$).\n";
$connection->close;
return 0;
}
......
......@@ -14,6 +14,8 @@ use Time::HiRes qw( gettimeofday );
use ZMQ::LibZMQ3;
use ZMQ::Constants qw(ZMQ_REP ZMQ_REQ ZMQ_LAST_ENDPOINT ZMQ_POLLIN ZMQ_FD ZMQ_DONTWAIT ZMQ_SNDMORE ZMQ_LINGER EFSM);
use Zircon::Context::ZMQ::Ctx;
use base 'Zircon::Trace';
our $ZIRCON_TRACE_KEY = 'ZIRCON_CONTEXT_TRACE';
......@@ -50,11 +52,9 @@ sub transport_init {
$self->_request_callback($request_callback);
$self->_after_request_callback($after_callback);
my $_zmq_context = zmq_ctx_new;
$_zmq_context or die "zmq_ctx_new failed: $!";
$self->_zmq_context($_zmq_context);
$self->_zmq_context(Zircon::Context::ZMQ::Ctx->new); # get a singleton zmq_ctx
my $responder = zmq_socket($_zmq_context, ZMQ_REP);
my $responder = zmq_socket($self->_zmq_context, ZMQ_REP);
$responder or die "failed to get ZMQ_REP socket: $!";
my $local_endpoint = $self->local_endpoint;
......@@ -525,7 +525,7 @@ sub _zmq_context {
my ($self, @args) = @_;
($self->{'_zmq_context'}) = @args if @args;
my $_zmq_context = $self->{'_zmq_context'};
return $_zmq_context;
return $_zmq_context ? $_zmq_context->ctx : undef;
}
sub _zmq_responder {
......@@ -624,11 +624,7 @@ sub disconnect {
zmq_close($responder);
$self->zircon_trace('...closed');
}
if (my $ctx = $self->_zmq_context) {
$self->zircon_trace('context...');
zmq_ctx_destroy($ctx);
$self->zircon_trace('...destroyed');
}
$self->_zmq_context(undef);
$self->zircon_trace('disconnected');
return;
......
# Singleton for the ZeroMQ context object, of which there must be only one per process
package Zircon::Context::ZMQ::Ctx;
use strict;
use warnings;
use Scalar::Util qw( weaken refaddr );
use ZMQ::LibZMQ3;
use parent 'Zircon::Trace';
our $ZIRCON_TRACE_KEY = 'ZIRCON_CONTEXT_TRACE';
my $_singleton;
sub new {
my ($class) = @_;
if ($_singleton) {
$class->zircon_trace("returning existing 0MQ context '%x'", $_singleton->ctx);
return $_singleton;
} else {
$class->zircon_trace('creating new 0MQ context');
my $_ctx = zmq_ctx_new;
$_ctx or die "zmq_ctx_new failed: $!";
$class->zircon_trace("new context '%x'", $_ctx);
$_singleton = bless { _ctx => $_ctx }, $class;
my $retval = $_singleton;
weaken $_singleton;
return $retval;
}
}
sub ctx {
my ($self) = @_;
return $self->{_ctx};
}
# For tests
sub exists {
return $_singleton && $_singleton->{_ctx};
}
sub zircon_trace_prefix { return 'ZMQ::Ctx' }
DESTROY {
my ($self) = @_;
$self->zircon_trace("ctx = '%x'", refaddr $self->ctx // 'undef');
if (my $_ctx = $self->ctx) {
$self->zircon_trace('destroying 0MQ context...');
zmq_ctx_destroy($_ctx);
undef $self->{_ctx};
$self->zircon_trace('...destroyed');
}
return;
}
1;
=head1 AUTHOR
Ana Code B<email> anacode@sanger.ac.uk
......@@ -217,6 +217,7 @@ sub _request {
$self->connection->after(sub {
$self->zircon_trace('shutdown: exiting');
$self->close;
CORE::exit;
});
$self->server->zircon_server_shutdown;
......
#! /usr/bin/env perl
use strict;
use warnings;
use Test::More;
plan tests => 7;
my $module = 'Zircon::Context::ZMQ::Ctx';
use_ok($module);
my $c1 = new_ok($module);
my $c2 = new_ok($module);
is($c1, $c2, 'singleton');
ok($module->exists, 'singleton extant');
undef $c1;
ok($module->exists, 'singleton still extant');
undef $c2;
ok(not($module->exists), 'singleton destroyed');
done_testing;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment