The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#ifndef  __PERL_ZEROMQ_H__
#define  __PERL_ZEROMQ_H__
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include "xshelper.h"
#include <zmq.h>
#include <errno.h>
#include <unistd.h>

#ifndef PERLZMQ_TRACE
#define PERLZMQ_TRACE 0
#endif
#define _ERRNO        errno
#define SET_BANG      P5ZMQ3_set_bang(aTHX_ _ERRNO)

typedef struct {
#ifdef tTHX /* tTHX doesn't exist in older perls */
    tTHX    interp;
#else
    PerlInterpreter *interp;
#endif
    pid_t   pid;
    void   *ctxt;
} P5ZMQ3_Context;

typedef struct {
    void  *socket;
    SV    *assoc_ctxt; /* keep context around with sockets so we know */
    pid_t  pid;
} P5ZMQ3_Socket;

typedef zmq_msg_t P5ZMQ3_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

#define P5ZMQ3_FUNCTION_UNAVAILABLE(name) \
    { \
        int major, minor, patch; \
        zmq_version(&major, &minor, &patch); \
        croak("%s is not available in this version of libzmq (%d.%d.%d)", name, major, minor, patch ); \
    }

#if (PERLZMQ_TRACE > 0)
#define P5ZMQ3_TRACE(...) \
    { \
        PerlIO_printf(PerlIO_stderr(), "[perlzmq (%d)] ", PerlProc_getpid() ); \
        PerlIO_printf(PerlIO_stderr(), __VA_ARGS__); \
        PerlIO_printf(PerlIO_stderr(), "\n"); \
    }
#else
#define P5ZMQ3_TRACE(...)
#endif /* if PERLZMQ_TRACE */

#ifdef MGf_LOCAL
#define P5ZMQ3_DECL_VTBL(klass, get_cb, set_cb, len_cb, clear_cb, free_cb, copy_cb, dup_cb, local_cb) \
static MGVTBL klass##_vtbl = { /* for identity */ \
    get_cb, /* get */ \
    set_cb, /* set */ \
    len_cb, /* len */ \
    clear_cb, /* clear */ \
    free_cb, /* free */ \
    copy_cb, /* copy */ \
    dup_cb, /* dup */ \
    local_cb  /* local */ \
};
#else /* MGf_LOCAL */
#define P5ZMQ3_DECL_VTBL(klass, get_cb, set_cb, len_cb, clear_cb, free_cb, copy_cb, dup_cb) \
static MGVTBL klass##_vtbl = { /* for identity */ \
    get_cb, /* get */ \
    set_cb, /* set */ \
    len_cb, /* len */ \
    clear_cb, /* clear */ \
    free_cb, /* free */ \
    copy_cb, /* copy */ \
    dup_cb /* dup */ \
};
#endif /* MGf_LOCAL */

#define P5ZMQ3_STRUCT2SV(arg, var, klass, type) \
    { \
        if (!var)          /* if null */ \
            SvOK_off(arg); /* then return as undef instead of reaf to undef */ \
        else { \
            /* setup $arg as a ref to a blessed hash hv */ \
            MAGIC *mg; \
            HV *hv = newHV(); \
            const char *classname = #klass; \
            /* take (sub)class name to use from class_sv if appropriate */ \
            if (SvMAGICAL(class_sv)) \
                mg_get(class_sv); \
                if (SvOK( class_sv ) && sv_derived_from(class_sv, classname ) ) { \
                if(SvROK(class_sv) && SvOBJECT(SvRV(class_sv))) { \
                    classname = sv_reftype(SvRV(class_sv), TRUE); \
                } else { \
                    classname = SvPV_nolen(class_sv); \
                } \
            } \
    \
            sv_setsv(arg, sv_2mortal(newRV_noinc((SV*)hv))); \
            (void)sv_bless(arg, gv_stashpv(classname, TRUE)); \
            mg = sv_magicext((SV*)hv, NULL, PERL_MAGIC_ext, &type##_vtbl, (char*) var, 0); \
            mg->mg_flags |= MGf_DUP; \
        } \
    }

#define P5ZMQ3_SV2STRUCT(arg, var, klass, type, errcode) \
    { \
        MAGIC *mg; \
        var = NULL; \
        if (! sv_isobject(arg)) { \
            croak("Argument is not an object"); \
        } \
    \
        /* if it got here, it's a blessed reference. better be an HV */ \
        { \
            SV *svr; \
            SV **closed; \
            svr = SvRV(arg); \
            if (! svr ) { \
                croak("PANIC: Could not get reference from blessed object."); \
            } \
    \
            if (SvTYPE(svr) != SVt_PVHV) { \
                croak("PANIC: Underlying storage of blessed reference is not a hash."); \
            } \
    \
            closed = hv_fetchs( (HV *) svr, "_closed", 0 ); \
            if (closed != NULL && SvTRUE(*closed)) { \
                /* if it's already closed, just return */ \
                P5ZMQ3_set_bang( aTHX_ errcode); \
                XSRETURN_EMPTY; \
            } \
        } \
    \
        mg = type##_mg_find(aTHX_ SvRV(arg), &type##_vtbl); \
        if (mg) { \
            var = (type *) mg->mg_ptr; \
        } \
    \
        if (var == NULL) \
            croak("Invalid ##klass## object (perhaps you've already freed it?)"); \
    }

#endif /* __PERL_ZERMQ_H__ */