static void
rowreq_init_common(PLCB_t *parent, AV *req)
{
    SV *selfref;

    av_fill(req, PLCB_VHIDX_MAX);
    av_store(req, PLCB_VHIDX_ROWBUF, newRV_noinc((SV *)newAV()));
    av_store(req, PLCB_VHIDX_RAWROWS, newRV_noinc((SV *)newAV()));
    av_store(req, PLCB_VHIDX_PARENT, newRV_inc(parent->selfobj));

    selfref = newRV_inc((SV*)req);
    sv_rvweaken(selfref);
    av_store(req, PLCB_VHIDX_SELFREF, selfref);
}
static SV *parser_fn(OP *(fn)(pTHX_ U32), bool named) {
    I32 floor;
    CV *code;
    U8 errors;
 
    ENTER;
 
    PL_curcop = &PL_compiling;
    SAVEVPTR(PL_op);
    SAVEI8(PL_parser->error_count);
    PL_parser->error_count = 0;
 
    floor = start_subparse(0, named ? 0 : CVf_ANON);
    code = newATTRSUB(floor, NULL, NULL, NULL, fn(aTHX_ 0));
 
    errors = PL_parser->error_count;
 
    LEAVE;
 
    if (errors) {
        ++PL_parser->error_count;
        return newSV(0);
    }
    else {
        if (CvCLONE(code)) {
            code = cv_clone(code);
        }
 
        return newRV_inc((SV*)code);
    }
}
static void
call_async(plcb_OPCTX *ctx, AV *resobj)
{
    SV *cv = ctx->u.callback;
    dSP;

    if (cv == NULL || SvOK(cv) == 0) {
        warn("Context does not have a callback (%p)!", cv);
        return;
    }

    if ((ctx->flags & PLCB_OPCTXf_IMPLICIT) == 0) {
        if (ctx->nremaining && (ctx->flags & PLCB_OPCTXf_CALLEACH) == 0) {
            return; /* Still have ops. Only call once they're all complete */
        }
    }

    ENTER;
    SAVETMPS;
    PUSHMARK(SP);
    XPUSHs(sv_2mortal(newRV_inc((SV*)resobj)));
    PUTBACK;
    call_sv(cv, G_DISCARD);
    FREETMPS;
    LEAVE;

    if (ctx->nremaining == 0 && (ctx->flags & PLCB_OPCTXf_CALLDONE)) {
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        call_sv(cv, G_DISCARD);
        FREETMPS;
        LEAVE;
    }
}
static void
bootstrap_callback(lcb_t instance, lcb_error_t status)
{
    dSP;
    PLCB_t *obj = (PLCB_t*) lcb_get_cookie(instance);
    if (!obj->async) {
        return;
    }
    if (!obj->conncb) {
        warn("Object %p does not have a connect callback!", obj);
        return;
    }
    printf("Invoking callback for connect..!\n");

    ENTER;SAVETMPS;PUSHMARK(SP);

    XPUSHs(sv_2mortal(newRV_inc(obj->selfobj)));
    XPUSHs(sv_2mortal(newSViv(status)));
    PUTBACK;

    call_sv(obj->conncb, G_DISCARD);
    SPAGAIN;
    FREETMPS;LEAVE;
    SvREFCNT_dec(obj->conncb); obj->conncb = NULL;
}
Beispiel #5
0
SV *p5_get_global(PerlInterpreter *my_perl, const char* name) {
    PERL_SET_CONTEXT(my_perl);
    if (strlen(name) < 2)
        return NULL;

    if (name[0] == '$')
        return get_sv(&name[1], 0);

    if (name[0] == '@')
        return sv_2mortal(newRV_inc((SV *)get_av(&name[1], 0)));

    if (name[0] == '%')
        return sv_2mortal(newRV_inc((SV *)get_hv(&name[1], 0)));

    return NULL;
}
Beispiel #6
0
static html_valid_status_t
html_valid_tag_information (HV * hv)
{
    int i;
    // n_html_tags is defined in html-tidy5.h as part of the "extra"
    // material.
    html_valid_tag_t tags[n_html_tags];
    TagInformation (tags);
    for (i = 0; i < n_html_tags; i++) {
	int name_len;
	AV * constants;
	SV * constants_ref;
	constants = newAV ();
	// Store the ID for reverse lookup of attributes.
	av_push (constants, newSVuv (i));
	av_push (constants, newSVuv (tags[i].versions));
	av_push (constants, newSVuv (tags[i].model));

	constants_ref = newRV_inc ((SV *) constants);
	name_len = strlen (tags[i].name);
/*
	fprintf (stderr, "Storing %s (%d) into hash.\n",
		 tags[i].name, name_len);
*/
	(void) hv_store (hv, tags[i].name, name_len, constants_ref, 0 /* no hash value */);
    }
    return html_valid_ok;
}
SV *
PLCBA_construct(const char *pkg, AV *options)
{
    PLCBA_t *async;
    char *host, *username, *password, *bucket;
    libcouchbase_t instance;
    SV *blessed_obj;
    
    Newxz(async, 1, PLCBA_t);
    
    extract_async_options(async, options);
    
    plcb_ctor_conversion_opts(&async->base, options);
    
    plcb_ctor_cbc_opts(options, &host, &username, &password, &bucket);
    instance = libcouchbase_create(host, username, password, bucket,
                                   plcba_make_io_opts(async));
    
    if(!instance) {
        die("Couldn't create instance!");
    }
    
    plcb_ctor_init_common(&async->base, instance, options);
    plcba_setup_callbacks(async);
    async->base_rv = newRV_inc(newSViv(PTR2IV(&(async->base))));
    
    blessed_obj = newSV(0);
    sv_setiv(newSVrv(blessed_obj, pkg), PTR2IV(async));
    return blessed_obj;
}
Beispiel #8
0
SV *modperl_pnotes(pTHX_ HV **pnotes, SV *key, SV *val,
                   request_rec *r, conn_rec *c) {
    SV *retval = (SV *)NULL;

    if (!*pnotes) {
        apr_pool_t *pool = r ? r->pool : c->pool;
        void *cleanup_data;
        *pnotes = newHV();

        cleanup_data = modperl_pnotes_cleanup_data(aTHX_ pnotes, pool);

        apr_pool_cleanup_register(pool, cleanup_data,
                                  modperl_cleanup_pnotes,
                                  apr_pool_cleanup_null);
    }

    if (key) {
        STRLEN len;
        char *k = SvPV(key, len);

        if (val) {
            retval = *hv_store(*pnotes, k, len, SvREFCNT_inc(val), 0);
        }
        else if (hv_exists(*pnotes, k, len)) {
            retval = *hv_fetch(*pnotes, k, len, FALSE);
        }

        return retval ? SvREFCNT_inc(retval) : &PL_sv_undef;
    }
    return newRV_inc((SV *)*pnotes);
}
static void modify_event_perl(PLCBA_t *async,
                              PLCBA_c_event *cevent,
                              PLCBA_evaction_t action,
                              short flags)
{
    SV **tmpsv;

    tmpsv = av_fetch(cevent->pl_event, PLCBA_EVIDX_FD, 1);
    if (SvIOK(*tmpsv)) {
        if (SvIV(*tmpsv) != cevent->fd) {
            /*file descriptor mismatch!*/
            av_delete(cevent->pl_event, PLCBA_EVIDX_DUPFH, G_DISCARD);
        }

    } else {
        sv_setiv(*tmpsv, cevent->fd);
    }
    
    plcb_call_sv_with_args_noret(async->cv_evmod,
                                 1,
                                 3,
                                 newRV_inc( (SV*)(cevent->pl_event)),
                                 newSViv(action),
                                 newSViv(flags));
    
    /*set the current flags*/
    if (action != PLCBA_EVACTION_SUSPEND && action != PLCBA_EVACTION_RESUME) {
        sv_setiv( *(av_fetch(cevent->pl_event, PLCBA_EVIDX_WATCHFLAGS, 1)),
                 flags);
    }
    
    /*set the current state*/
    sv_setiv( *(av_fetch(cevent->pl_event, PLCBA_EVIDX_STATEFLAGS, 1)),
             cevent->state);
}
Beispiel #10
0
void h3(void *arg) {
    int argc = 3;
    char *argv[] = { "", "-e", "use Data::Dumper;"
        "sub dump_perl { print STDERR Data::Dumper::Dumper([shift]); }", 
            NULL };
    char *env[] = { NULL };
    void *original_context = PERL_GET_CONTEXT;
    SV *sv;

    PERL_SYS_INIT3(&argc,&argv,&env);
    my_perl = perl_alloc();

    sv = newRV_inc(newSViv(5));

    PERL_SET_CONTEXT(my_perl);
    perl_construct(my_perl);
    
    perl_parse(my_perl, mine_xs_init, argc, argv, NULL);

    call_dump_perl(sv);
    
    perl_destruct(my_perl);
    perl_free(my_perl);

    PERL_SET_CONTEXT(original_context);
}
Beispiel #11
0
static void ctor_extract_methpairs(AV *options,
                                   int idx, SV **outmeth, SV **inmeth)
{
    SV **tmpsv;
    AV *methav;
    int ii;
    
    SV **assgn_array[] = { outmeth, inmeth };
    
    *outmeth = *inmeth = NULL;
    if ( (tmpsv = av_fetch(options, idx, 0)) == NULL ) {
        return;
    }
    
    if (SvROK(*tmpsv) == 0 ||
        ((methav = (AV*)SvRV(*tmpsv)) && SvTYPE(methav) != SVt_PVAV) ||
        av_len(methav) != 1) {
        die("Expected an array reference with two elements");
    }
    
    for (ii = 0; ii < 2; ii++) {
        tmpsv = av_fetch(methav, ii, 0);
        if(SvROK(*tmpsv) == 0 || SvTYPE(SvRV(*tmpsv)) != SVt_PVCV) {
            die("Expected code reference.");
        }
        *(assgn_array[ii]) = newRV_inc(SvRV(*tmpsv));
    }
}
Beispiel #12
0
JSObject *
PJS_InitPerlArrayClass(
    pTHX_
    JSContext *cx,
    JSObject *global
) {
    JSObject *proto;
    JSObject *stash = PJS_GetPackageObject(aTHX_ cx, PerlArrayPkg);
    proto = JS_InitClass(
        cx,
	global,
	stash,
	&perlarray_class,
	PerlArray, 0, 
        perlarray_props, perlarray_methods,
        NULL, NULL
    );
    if(!proto ||
       !JS_DefineProperty(cx, stash, PJS_PROXY_PROP,
	                  OBJECT_TO_JSVAL(proto), NULL, NULL, 0))
	return NULL;

    return PJS_CreateJSVis(aTHX_ cx, proto,
		newRV_inc((SV *)get_av(NAMESPACE"PerlArray::prototype",1)));
}
Beispiel #13
0
/*
 *	Parse a configuration section, and populate a HV.
 *	This function is recursively called (allows to have nested hashes.)
 */
static void perl_parse_config(CONF_SECTION *cs, int lvl, HV *rad_hv)
{
	if (!cs || !rad_hv) return;

	int indent_section = (lvl + 1) * 4;
	int indent_item = (lvl + 2) * 4;

	DEBUG("%*s%s {", indent_section, " ", cf_section_name1(cs));

	CONF_ITEM *ci = NULL;

	while ((ci = cf_item_next(cs, ci))) {
		/*
		 *  This is a section.
		 *  Create a new HV, store it as a reference in current HV,
		 *  Then recursively call perl_parse_config with this section and the new HV.
		 */
		if (cf_item_is_section(ci)) {
			CONF_SECTION	*sub_cs = cf_item_to_section(ci);
			char const	*key = cf_section_name1(sub_cs); /* hash key */
			HV		*sub_hv;
			SV		*ref;

			if (!key) continue;

			if (hv_exists(rad_hv, key, strlen(key))) {
				WARN("Ignoring duplicate config section '%s'", key);
				continue;
			}

			sub_hv = newHV();
			ref = newRV_inc((SV*) sub_hv);

			(void)hv_store(rad_hv, key, strlen(key), ref, 0);

			perl_parse_config(sub_cs, lvl + 1, sub_hv);
		} else if (cf_item_is_pair(ci)){
			CONF_PAIR	*cp = cf_item_to_pair(ci);
			char const	*key = cf_pair_attr(cp);	/* hash key */
			char const	*value = cf_pair_value(cp);	/* hash value */

			if (!key || !value) continue;

			/*
			 *  This is an item.
			 *  Store item attr / value in current HV.
			 */
			if (hv_exists(rad_hv, key, strlen(key))) {
				WARN("Ignoring duplicate config item '%s'", key);
				continue;
			}

			(void)hv_store(rad_hv, key, strlen(key), newSVpvn(value, strlen(value)), 0);

			DEBUG("%*s%s = %s", indent_item, " ", key, value);
		}
	}

	DEBUG("%*s}", indent_section, " ");
}
Beispiel #14
0
SV  *HRXSATTR_get_hash(SV *self)
{
    hrattr_simple *attr = attr_from_sv(SvRV(self));
    if(attr->attrhash) {
        return newRV_inc((SV*)attr->attrhash);
    } else {
        return &PL_sv_undef;
    }
}
Beispiel #15
0
static SV *make_env(request_rec *r, psgi_dir_config *c)
{
    dTHX;
    HV *env;
    AV *version;
    char *url_scheme, *script_name, *vpath, *path_info;
    SV *input, *errors;

    env = newHV();

    ap_add_cgi_vars(r);
    ap_add_common_vars(r);

    /* fix SCRIPT_NAME & PATH_INFO */
    if (c->location == NULL || strcmp(c->location, "/") == 0) {
        script_name = "";
    } else {
        script_name = c->location;
    }
    vpath = apr_pstrcat(r->pool,
            apr_table_get(r->subprocess_env, "SCRIPT_NAME"),
            apr_table_get(r->subprocess_env, "PATH_INFO"),
            NULL);
    path_info = &vpath[strlen(script_name)];
    apr_table_set(r->subprocess_env, "PATH_INFO", path_info);
    apr_table_set(r->subprocess_env, "SCRIPT_NAME", script_name);

    apr_table_do(copy_env, env, r->subprocess_env, NULL);

    version = newAV();
    av_push(version, newSViv(1));
    av_push(version, newSViv(0));
    (void) hv_store(env, "psgi.version", 12, newRV_noinc((SV *) version), 0);

    url_scheme = apr_table_get(r->subprocess_env, "HTTPS") == NULL ?  "http" : "https";
    (void) hv_store(env, "psgi.url_scheme", 15, newSVpv(url_scheme, 0), 0);

    input = newRV_noinc(newSV(0));
    sv_magic(SvRV(input), NULL, PERL_MAGIC_ext, NULL, 0);
    mg_find(SvRV(input), PERL_MAGIC_ext)->mg_obj = (void *) r;
    sv_bless(input, gv_stashpv("ModPSGI::Input", 1));
    (void) hv_store(env, "psgi.input", 10, input, 0);

    errors = newRV_noinc(newSV(0));
    sv_magic(SvRV(errors), NULL, PERL_MAGIC_ext, NULL, 0);
    mg_find(SvRV(errors), PERL_MAGIC_ext)->mg_obj = (void *) r;
    sv_bless(errors, gv_stashpv("ModPSGI::Errors", 1));
    (void) hv_store(env, "psgi.errors", 11, errors, 0);

    (void) hv_store(env, "psgi.multithread", 16, newSViv(psgi_multithread), 0);
    (void) hv_store(env, "psgi.multiprocess", 17, newSViv(psgi_multiprocess), 0);
    (void) hv_store(env, "psgi.run_once", 13, newSViv(0), 0);
    (void) hv_store(env, "psgi.nonblocking", 16, newSViv(0), 0);

    return newRV_inc((SV *) env);
}
Beispiel #16
0
static bool
collect_all_symbols (const char *key, STRLEN keylen, SV *val, void *ud)
{
    HV *hash = (HV *)ud;

    if (!hv_store (hash, key, keylen, newRV_inc(val), 0)) {
        croak("failed to store symbol ref");
    }

    return TRUE;
}
Beispiel #17
0
void VParserXs::call (
    string* rtnStrp,	/* If non-null, load return value here */
    int params,		/* Number of parameters */
    const char* method,	/* Name of method to call */
    ...)		/* Arguments to pass to method's @_ */
{
    // Call $perlself->method (passedparam1, parsedparam2)
    if (debug()) cout << "CALLBACK "<<method<<endl;
    va_list ap;
    va_start(ap, method);
    {
	dSP;				/* Initialize stack pointer */
	ENTER;				/* everything created after here */
	SAVETMPS;			/* ...is a temporary variable. */
	PUSHMARK(SP);			/* remember the stack pointer */
	SV* selfsv = newRV_inc(m_self);	/* $self-> */
	XPUSHs(sv_2mortal(selfsv));

	while (params--) {
	    char* text = va_arg(ap, char *);
	    SV* sv;
	    if (text) {
		sv = sv_2mortal(newSVpv (text, 0));
	    } else {
		sv = &PL_sv_undef;
	    }
	    XPUSHs(sv);			/* token */
	}

	PUTBACK;			/* make local stack pointer global */

	if (rtnStrp) {
	    int rtnCount = perl_call_method ((char*)method, G_SCALAR);
	    SPAGAIN;			/* refresh stack pointer */
	    if (rtnCount > 0) {
		SV* sv = POPs;
		//printf("RTN %ld %d %s\n", SvTYPE(sv),SvTRUE(sv),SvPV_nolen(sv));
#ifdef SvPV_nolen	// Perl 5.6 and later
		*rtnStrp = SvPV_nolen(sv);
#else
		*rtnStrp = SvPV(sv,PL_na);
#endif
	    }
	    PUTBACK;
	} else {
	    perl_call_method ((char*)method, G_DISCARD | G_VOID);
	}

	FREETMPS;			/* free that return value */
	LEAVE;				/* ...and the XPUSHed "mortal" args.*/
    }
    va_end(ap);
}
Beispiel #18
0
static SV *
custom_convert(AV *docav, SV *meth, SV *input, uint32_t *flags, int direction)
{
    dSP;
    SV *ret;
    SV *flags_rv;
    SV *input_rv;
    int callflags;

    ENTER; SAVETMPS;
    PUSHMARK(SP);

    input_rv = sv_2mortal(newRV_inc(input));
    flags_rv = sv_2mortal(newRV_noinc(newSVuv(*flags)));

    XPUSHs(sv_2mortal(newRV_inc( (SV *)docav)));
    XPUSHs(input_rv);
    XPUSHs(flags_rv);

    PUTBACK;

    callflags = G_VOID|G_DISCARD;
    if (direction == CONVERT_OUT) {
        callflags |= G_EVAL;
    }

    call_sv(meth, callflags);
    SPAGAIN;

    if (SvTRUE(ERRSV)) {
        ret = input;
    } else {
        warn("Conversion function failed");
        ret = SvRV(input_rv);
        *flags = SvUV(SvRV(flags_rv));
    }

    SvREFCNT_inc(ret);
    return ret;
}
Beispiel #19
0
USER_OBJECT_
R_makePerlReference(USER_OBJECT_ s_obj)
{
   SV *obj, *ref;
   USER_OBJECT_ ans;
   dTHX;

   obj = toPerl(s_obj, TRUE);
   /* SvREFCNT_inc(obj); not needed */
   ref = newRV_inc(obj);
   ans = createPerlReference((SV*) ref);
   return(ans);
}
static void modify_timer_perl(PLCBA_t *async,
                              PLCBA_c_event *cevent,
                              uint32_t usecs,
                              PLCBA_evaction_t action)
{
    //warn("Calling cv_timermod");
    plcb_call_sv_with_args_noret(async->cv_timermod,
                                 1,
                                 3,
                                 newRV_inc( (SV*)cevent->pl_event ),
                                 newSViv(action),
                                 newSVuv(usecs));
}
Beispiel #21
0
/* convert array header of modperl_handlers_t's to AV ref of CV refs */
SV *modperl_handler_perl_get_handlers(pTHX_ MpAV **handp, apr_pool_t *p)
{
    AV *av = newAV();
    int i;
    modperl_handler_t **handlers;

    if (!(handp && *handp)) {
        return &PL_sv_undef;
    }

    av_extend(av, (*handp)->nelts - 1);

    handlers = (modperl_handler_t **)(*handp)->elts;

    for (i=0; i<(*handp)->nelts; i++) {
        modperl_handler_t *handler = NULL;
        GV *gv;

        if (MpHandlerPARSED(handlers[i])) {
            handler = handlers[i];
        }
        else {
#ifdef USE_ITHREADS
            if (!MpHandlerDYNAMIC(handlers[i])) {
                handler = modperl_handler_dup(p, handlers[i]);
            }
#endif
            if (!handler) {
                handler = handlers[i];
            }

            if (!modperl_mgv_resolve(aTHX_ handler, p, handler->name, TRUE)) {
                MP_TRACE_h(MP_FUNC, "failed to resolve handler %s",
                           handler->name);
            }

        }

        if (handler->mgv_cv) {
            if ((gv = modperl_mgv_lookup(aTHX_ handler->mgv_cv))) {
                CV *cv = modperl_mgv_cv(gv);
                av_push(av, newRV_inc((SV*)cv));
            }
        }
        else {
            av_push(av, newSVpv(handler->name, 0));
        }
    }

    return newRV_noinc((SV*)av);
}
Beispiel #22
0
SV* THX_MopMcV_get_method(pTHX_ SV* metaclass, SV* name) {
    HV* stash = (HV*) SvRV(metaclass);

    HE* method_gv_he = hv_fetch_ent(stash, name, 0, 0);
    if (method_gv_he != NULL) {
        GV* method_gv = (GV*) HeVAL(method_gv_he);
        CV* method    = GvCV(method_gv);
        if (method != NULL && GvSTASH(CvGV(method)) == stash) {
            return newRV_inc((SV*) method);  
        }
    }
    
    return NULL;
}
Beispiel #23
0
cfish_Hash*
LUCY_Doc_Dump_IMP(lucy_Doc *self) {
    dTHX;
    lucy_DocIVARS *const ivars = lucy_Doc_IVARS(self);
    cfish_Hash *dump = cfish_Hash_new(0);
    CFISH_Hash_Store_Utf8(dump, "_class", 6,
                          (cfish_Obj*)CFISH_Str_Clone(lucy_Doc_get_class_name(self)));
    CFISH_Hash_Store_Utf8(dump, "doc_id", 7,
                          (cfish_Obj*)cfish_Str_newf("%i32", ivars->doc_id));
    SV *fields_sv = newRV_inc((SV*)ivars->fields);
    CFISH_Hash_Store_Utf8(dump, "fields", 6,
                          XSBind_perl_to_cfish(aTHX_ fields_sv, CFISH_HASH));
    SvREFCNT_dec(fields_sv);
    return dump;
}
Beispiel #24
0
static int output_body_obj(request_rec *r, SV *obj, int type)
{
    dTHX;
    SV *buf_sv;
    apr_off_t clen = 0;
    STRLEN len;
    dSP;
    char *buf;
    int count;

    if (type == SVt_PVMG && !respond_to(obj, "getline")) {
        server_error(r, "response body object must be able to getline");
        return HTTP_INTERNAL_SERVER_ERROR;
    }

    ENTER;
    SAVETMPS;
    SAVESPTR(PL_rs);
    PL_rs = newRV_inc(newSViv(AP_IOBUFSIZE));
    while (1) {
        PUSHMARK(SP);
        XPUSHs(obj);
        PUTBACK;
        count = call_method("getline", G_SCALAR);
        if (count != 1) croak("Big trouble\n");
        SPAGAIN;
        buf_sv = POPs;
        if (SvOK(buf_sv)) {
            buf = SvPV(buf_sv, len);
            clen += len;
            ap_rwrite(buf, len, r);
        } else {
            break;
        }
    }
    if (clen > 0) {
        ap_set_content_length(r, clen);
    }
    PUSHMARK(SP);
    XPUSHs(obj);
    PUTBACK;
    call_method("close", G_DISCARD);
    SPAGAIN;
    PUTBACK;
    FREETMPS;
    LEAVE;
    return OK;
}
static void
call_helper(AV *resobj, int cbtype, const lcb_RESPBASE *resp)
{
    dSP;
    const char *methname;

    ENTER;
    SAVETMPS;
    PUSHMARK(SP);

    XPUSHs(sv_2mortal(newRV_inc((SV*)resobj)));


    if (cbtype == LCB_CALLBACK_STATS) {
        const lcb_RESPSTATS *sresp = (const void *)resp;

        /** Call as statshelper($doc,$server,$key,$value); */
        XPUSHs(sv_2mortal(newSVpv(sresp->server, 0)));
        XPUSHs(sv_2mortal(newSVpvn(sresp->key, sresp->nkey)));
        if (sresp->value) {
            XPUSHs(sv_2mortal(newSVpvn(sresp->value, sresp->nvalue)));
        }
        methname = PLCB_STATS_PLHELPER;

    } else if (cbtype == LCB_CALLBACK_OBSERVE) {
        const lcb_RESPOBSERVE *oresp = (const void *)resp;

        /** Call as obshelper($doc,$status,$cas,$ismaster) */
        XPUSHs(sv_2mortal(newSVuv(oresp->status)));
        XPUSHs(sv_2mortal(plcb_sv_from_u64_new(&oresp->cas)));
        XPUSHs(oresp->ismaster ? &PL_sv_yes : &PL_sv_no);
        methname = PLCB_OBS_PLHELPER;
    } else {
        return;
    }

    PUTBACK;
    call_pv(methname, G_DISCARD|G_EVAL);
    SPAGAIN;

    if (SvTRUE(ERRSV)) {
        warn("Got error in %s: %s", methname, SvPV_nolen(ERRSV));
    }

    FREETMPS;
    LEAVE;
}
Beispiel #26
0
Datei: Doc.c Projekt: gitpan/Lucy
static SV*
S_nfreeze_fields(lucy_Doc *self) {
    lucy_DocIVARS *const ivars = lucy_Doc_IVARS(self);
    dSP;
    ENTER;
    SAVETMPS;
    EXTEND(SP, 1);
    PUSHMARK(SP);
    mPUSHs((SV*)newRV_inc((SV*)ivars->fields));
    PUTBACK;
    call_pv("Storable::nfreeze", G_SCALAR);
    SPAGAIN;
    SV *frozen = POPs;
    (void)SvREFCNT_inc(frozen);
    PUTBACK;
    FREETMPS;
    LEAVE;
    return frozen;
}
Beispiel #27
0
SV *get_single_hook(pTHX_ const SingleHook *hook)
{
  SV *sv;

  assert(hook != NULL);

  sv = hook->sub;

  if (sv == NULL)
    return NULL;

  sv = newRV_inc(sv);

  if (hook->arg)
  {
    AV *av = newAV();
    int j, len = 1 + av_len(hook->arg);

    av_extend(av, len);
    if (av_store(av, 0, sv) == NULL)
      fatal("av_store() failed in get_hooks()");

    for (j = 0; j < len; j++)
    {
      SV **pSV = av_fetch(hook->arg, j, 0);

      if (pSV == NULL)
        fatal("NULL returned by av_fetch() in get_hooks()");

      SvREFCNT_inc(*pSV);

      if (av_store(av, j+1, *pSV) == NULL)
        fatal("av_store() failed in get_hooks()");
    }

    sv = newRV_noinc((SV *) av);
  }

  return sv;
}
Beispiel #28
0
// create a new coro
SV * coroae_coro_new(CV *block) {
	SV *newobj = NULL;
	dSP;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        XPUSHs(sv_2mortal(newSVpv( "Coro", 4)));
        XPUSHs(newRV_inc((SV *)block));
        PUTBACK;
        call_method("new", G_SCALAR);
        SPAGAIN;
        if(SvTRUE(ERRSV)) {
                uwsgi_log("[uwsgi-perl error] %s", SvPV_nolen(ERRSV));
        }
        else {
                newobj = SvREFCNT_inc(POPs);
        }
	PUTBACK;
        FREETMPS;
        LEAVE;
	return newobj;
}
Beispiel #29
0
static long dimension_from_hook(pTHX_ SingleHook *hook, SV *self, HV *parent)
{
  dTHR;
  dXCPT;
  SV *sv, *in;
  long rv;

  assert(hook != NULL);
  assert(self != NULL);

  in = parent ? newRV_inc((SV *) parent) : NULL;
  sv = NULL;

  XCPT_TRY_START
  {
    sv = single_hook_call(aTHX_ self, "dimension", NULL, NULL, hook, in, 0);
  }
  XCPT_TRY_END

  XCPT_CATCH
  {
    if (parent)
    {
      CT_DEBUG(MAIN, ("freeing sv @ %p in dimension_from_hook:%d", in, __LINE__));
      SvREFCNT_dec(in);
    }

    XCPT_RETHROW;
  }

  assert(sv != NULL);

  rv = sv_to_dimension(aTHX_ sv, NULL);

  SvREFCNT_dec(sv);

  return rv;
}
Beispiel #30
0
SV* THX_newMopMmV(pTHX_ SV* code, U32 flags) {
    SV* method;

    CV* cv = (CV*) newSV(0);
    sv_upgrade((SV*) cv, SVt_PVCV);
    CvISXSUB_on(cv);
    CvXSUB(cv) = _MopMmV_wrapper;
    CvXSUBANY(cv).any_uv = PTR2UV(code);
    CvFILE(cv) = __FILE__;    

    CvANON_off(cv);
    CvMETHOD_on(cv);

    SvREFCNT_inc(code);

    method = newMopOV(newRV_inc((SV*) cv));

    if (flags & MopMmVf_STEAL_STASH) {
        MopMmV_assign_to_stash(method, CvGV(SvRV(code)), CvSTASH(SvRV(code)));
    }

    return method;
}