Ejemplo n.º 1
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);
}
Ejemplo n.º 2
0
SV *
PLCB__viewhandle_new(PLCB_t *parent,
    const char *ddoc, const char *view, const char *options, int flags)
{
    AV *req = NULL;
    SV *blessed;
    lcb_CMDVIEWQUERY cmd = { 0 };
    lcb_VIEWHANDLE vh = NULL;
    lcb_error_t rc;

    req = newAV();
    rowreq_init_common(parent, req);
    blessed = newRV_noinc((SV*)req);
    sv_bless(blessed, parent->view_stash);

    lcb_view_query_initcmd(&cmd, ddoc, view, options, viewrow_callback);
    cmd.cmdflags = flags; /* Trust lcb on this */
    cmd.handle = &vh;

    rc = lcb_view_query(parent->instance, req, &cmd);

    if (rc != LCB_SUCCESS) {
        SvREFCNT_dec(blessed);
        die("Couldn't issue view query: (0x%x): %s", rc, lcb_strerror(NULL, rc));
    } else {
        SvREFCNT_inc(req); /* For the callback */
        av_store(req, PLCB_VHIDX_VHANDLE, newSVuv(PTR2UV(vh)));
    }
    return blessed;
}
Ejemplo n.º 3
0
static JSBool
PerlArray(
    JSContext *cx,
    JSObject *obj,
    uintN argc,
    jsval *argv,
    jsval *rval
) {
    dTHX;
    AV *av = newAV();
    SV *ref = newRV_noinc((SV *)av);
    uintN arg;
    JSBool ok = JS_FALSE;
    SV *sv;

    /* If the path fails, the object will be finalized */
    JS_SetPrivate(cx, obj, (void *)newRV(&PL_sv_undef));

    av_extend(av, argc);
    for(arg = 0; arg < argc; arg++) {
	if(!PJS_ReflectJS2Perl(aTHX_ cx, argv[arg], &sv, 1) ||
	   !av_store(av, arg, sv)) goto fail;
    }

    if(SvTRUE(get_sv(NAMESPACE"PerlArray::construct_blessed", 0)))
	sv_bless(ref, gv_stashpv(PerlArrayPkg,0));

    ok = PJS_CreateJSVis(aTHX_ cx, obj, ref) != NULL;
    fail:
    sv_free(ref);
    return ok;
}
Ejemplo n.º 4
0
SV * newSVMiscRef(void * object, char * classname, int * newref)
{
	HV * previous;
	SV * result;
	if (!object)
		return newSVsv(&PL_sv_undef);
	previous = RetrieveMisc(object);
	if (previous) {
		/*printf("Retriveing object %d as HV %d\n", object, previous);*/
		result = newRV((SV*)previous);
		if (newref)
			*newref = 0;
	} else {
		HV * h = newHV();
		hv_store(h, "_gtk", 4, newSViv((long)object), 0);
		result = newRV((SV*)h);
		RegisterMisc(h, object);
		sv_bless(result, gv_stashpv(classname, FALSE));
		SvREFCNT_dec(h);
		if (newref)
			*newref = 1;
		/*printf("Storing object %p (%s) as HV %p (refcount: %d, %d)\n", object, classname, h, SvREFCNT(h), SvREFCNT(result));*/
	}
	return result;
}
Ejemplo n.º 5
0
SV *
PLCB__n1qlhandle_new(PLCB_t *parent, lcb_N1QLPARAMS *params, const char *host)
{
    AV *req;
    SV *blessed;
    lcb_CMDN1QL cmd = { 0 };
    lcb_error_t rc;

    rc = lcb_n1p_mkcmd(params, &cmd);
    if (rc != LCB_SUCCESS) {
        die("Error encoding N1QL parameters: %s", lcb_strerror(NULL, rc));
    }

    if (host && *host) {
        cmd.host = host;
    }
    cmd.callback = n1ql_callback;

    req = newAV();
    rowreq_init_common(parent, req);
    blessed = newRV_noinc((SV*)req);
    sv_bless(blessed, parent->n1ql_stash);

    rc = lcb_n1ql_query(parent->instance, req, &cmd);
    if (rc != LCB_SUCCESS) {
        SvREFCNT_dec(blessed);
        die("Couldn't issue N1QL query: (0x%x): %s", rc, lcb_strerror(NULL, rc));
    } else {
        SvREFCNT_inc(req);
    }

    return blessed;
}
Ejemplo n.º 6
0
/**
 * NI_aggregate(): aggregate two IP address ranges into new object.
 * @ipo1: first Net::IP::XS object.
 * @ipo2: second Net::IP::XS object.
 */
SV *
NI_aggregate(SV *ipo1, SV *ipo2)
{
    int version;
    int res;
    char buf[90];
    HV *stash;
    HV *hash;
    SV *ref;

    switch ((version = NI_hv_get_iv(ipo1, "ipversion", 9))) {
        case 4:  res = NI_aggregate_ipv4(ipo1, ipo2, buf); break;
        case 6:  res = NI_aggregate_ipv6(ipo1, ipo2, buf); break;
        default: res = 0;
    }

    if (!res) {
        return NULL;
    }

    hash  = newHV();
    ref   = newRV_noinc((SV*) hash);
    stash = gv_stashpv("Net::IP::XS", 1);
    sv_bless(ref, stash);
    res = NI_set(ref, buf, version);
    if (!res) {
        return NULL;
    }

    return ref;
}
Ejemplo n.º 7
0
SV* create_perl_object(void* cpp_obj, const char* perl_class_name, bool must_not_delete) {
	HV* underlying_hash;
	SV* perl_obj;
	HV* perl_obj_stash;
	object_link_data* link = new object_link_data;
	
	if (cpp_obj == NULL)
		return &PL_sv_undef;
		
	// create the underlying hash and make a ref to it
	underlying_hash = newHV();
	perl_obj = newRV_noinc((SV*)underlying_hash);
	//sv_2mortal(perl_obj);
	
	// get the stash and bless the ref (to the underlying hash) into it
	perl_obj_stash = gv_stashpv(perl_class_name, TRUE);
	sv_bless(perl_obj, perl_obj_stash);
	
	// fill in the data fields
	link->cpp_object = cpp_obj;
	link->perl_object = (SV*)underlying_hash;
	link->can_delete_cpp_object = must_not_delete ? false : true;
	link->perl_class_name = perl_class_name;
	
	// link the data via '~' magic
	// (we link to the underlying hash and not to the reference itself)
	sv_magic((SV*)underlying_hash, NULL, PERL_MAGIC_ext, (const char*)link, 0);	// cheat by storing data instead of a string
	
	// check this object
	DUMPME(1,perl_obj);
	
	return perl_obj;
}
Ejemplo n.º 8
0
static SV *
new_gdk_bitmap (GdkBitmap * bitmap, gboolean noinc)
{
	if (!bitmap)
		return &PL_sv_undef;
	return sv_bless (gperl_new_object (G_OBJECT (bitmap), noinc),
			 gv_stashpv ("Gtk2::Gdk::Bitmap", TRUE));
}
Ejemplo n.º 9
0
void p5_rebless_object(PerlInterpreter *my_perl, SV *obj) {
    SV * const inst = SvRV(obj);
    SV * const inst_ptr = newRV_noinc(inst);
    HV *stash = gv_stashpv("Perl6::Object", 0);
    if (stash == NULL)
        croak("Perl6::Object not found!? Forgot to call init_callbacks?");
    (void)sv_bless(inst_ptr, stash);
}
Ejemplo n.º 10
0
SV* THX_MopMcV_construct_instance(pTHX_ SV* metaclass, SV* repr) {
    // TODO:
    // This should handle all the attributes
    // and constructing things properly, which
    // should also include running all BUILD
    // methods.
    // - SL
    return sv_bless(repr, (HV*) SvRV(metaclass));
}
Ejemplo n.º 11
0
static void push_thread(pTHX, mthread* thread) {
	{
		dSP;
		SV* to_push = newRV_noinc(newSVuv(thread->id));
		sv_bless(to_push, gv_stashpv("threads::lite::tid", FALSE));
		XPUSHs(to_push);
		PUTBACK;
	}
}
Ejemplo n.º 12
0
/**
 * NI_ip_add_num(): add integer to object and get new object.
 * @ipo: Net::IP::XS object.
 * @num: integer to add to object (as a string).
 */
SV *
NI_ip_add_num(SV *ipo, const char *num)
{
    int version;
    unsigned long num_ulong;
    char *endptr;
    n128_t num_n128;
    char buf[(2 * (MAX_IPV6_STR_LEN - 1)) + 4];
    int res;
    HV *stash;
    HV *hash;
    SV *ref;
    int size;

    version = NI_hv_get_iv(ipo, "ipversion", 9);

    if (version == 4) {
        endptr = NULL;
        num_ulong = strtoul(num, &endptr, 10);
        if (STRTOUL_FAILED(num_ulong, num, endptr)) {
            return 0;
        }
        if (num_ulong > 0xFFFFFFFF) {
            return 0;
        }
        res = NI_ip_add_num_ipv4(ipo, num_ulong, buf);
        if (!res) {
            return 0;
        }
    } else if (version == 6) {
        res = n128_set_str_decimal(&num_n128, num, strlen(num));
        if (!res) {
            return 0;
        }

        res = NI_ip_add_num_ipv6(ipo, &num_n128, buf);
        if (!res) {
            return 0;
        }
    } else {
        return 0;
    }

    hash  = newHV();
    ref   = newRV_noinc((SV*) hash);
    stash = gv_stashpv("Net::IP::XS", 1);
    sv_bless(ref, stash);
    res = NI_set(ref, buf, version);
    if (!res) {
        return NULL;
    }

    return ref;
}
Ejemplo n.º 13
0
/*
 * Return a new Catalog object - only accepts an integer catalog value.
 * Use this purely for speed when creating Catalog objects from other XS code.
 * All other Catalog object creation should be done with the perl new() method.
 */
SV*
new_catalog(uint32_t cat)
{
	SV *iv, *ref;

	iv = newSVuv(cat);
	ref = newRV_noinc(iv);
	sv_bless(ref, Sun_Solaris_Exacct_Catalog_stash);
	SvREADONLY_on(iv);
	return (ref);
}
Ejemplo n.º 14
0
static SV *new_Token(pTHX_ Token *token)
{
	HV *hash = (HV*)new_Hash();
	(void)hv_stores(hash, "stype", set(new_Int(token->stype)));
	(void)hv_stores(hash, "type", set(new_Int(token->info.type)));
	(void)hv_stores(hash, "kind", set(new_Int(token->info.kind)));
	(void)hv_stores(hash, "line", set(new_Int(token->finfo.start_line_num)));
	(void)hv_stores(hash, "has_warnings", set(new_Int(token->info.has_warnings)));
	(void)hv_stores(hash, "name", set(new_String(token->info.name, strlen(token->info.name))));
	(void)hv_stores(hash, "data", set(new_String(token->data.c_str(), strlen(token->data.c_str()))));
	HV *stash = (HV *)gv_stashpv("Compiler::Lexer::Token", sizeof("Compiler::Lexer::Token") + 1);
	return sv_bless(new_Ref(hash), stash);
}
Ejemplo n.º 15
0
/*
 * Create a new ::Object by wrapping an ea_object_t in a perl SV.  This is used
 * to wrap exacct records that have been read from a file, or packed records
 * that have been inflated.
 */
SV *
new_xs_ea_object(ea_object_t *ea_obj)
{
	xs_ea_object_t	*xs_obj;
	SV		*sv_obj;

	/* Allocate space - use perl allocator. */
	New(0, xs_obj, 1, xs_ea_object_t);
	PERL_ASSERT(xs_obj != NULL);
	xs_obj->ea_obj = ea_obj;
	xs_obj->perl_obj = NULL;
	sv_obj = NEWSV(0, 0);
	PERL_ASSERT(sv_obj != NULL);

	/*
	 * Initialise according to the type of the passed exacct object,
	 * and bless the perl object into the appropriate class.
	 */
	if (ea_obj->eo_type == EO_ITEM) {
		if ((ea_obj->eo_catalog & EXT_TYPE_MASK) == EXT_EXACCT_OBJECT) {
			INIT_EMBED_ITEM_FLAGS(xs_obj);
		} else {
			INIT_PLAIN_ITEM_FLAGS(xs_obj);
		}
		sv_setiv(newSVrv(sv_obj, NULL), PTR2IV(xs_obj));
		sv_bless(sv_obj, Sun_Solaris_Exacct_Object_Item_stash);
	} else {
		INIT_GROUP_FLAGS(xs_obj);
		sv_setiv(newSVrv(sv_obj, NULL), PTR2IV(xs_obj));
		sv_bless(sv_obj, Sun_Solaris_Exacct_Object_Group_stash);
	}

	/*
	 * We are passing back a pointer masquerading as a perl IV,
	 * so make sure it can't be modified.
	 */
	SvREADONLY_on(SvRV(sv_obj));
	return (sv_obj);
}
Ejemplo n.º 16
0
/**
 * NI_binadd(): get new object from the sum of two IP addresses.
 * @ipo1: first Net::IP::XS object.
 * @ipo2: second Net::IP::XS object.
 */
SV *
NI_binadd(SV *ipo1, SV *ipo2)
{
    const char *binip1;
    const char *binip2;
    int version;
    char binbuf[130];
    char buf[45];
    int res;
    HV *stash;
    HV *hash;
    SV *ref;
    int iplen;

    binip1 = NI_hv_get_pv(ipo1, "binip", 5);
    if (!binip1) {
        binip1 = "";
    }

    binip2 = NI_hv_get_pv(ipo2, "binip", 5);
    if (!binip2) {
        binip2 = "";
    }

    res = NI_ip_binadd(binip1, binip2, binbuf, IPV6_BITSTR_LEN);
    if (!res) {
        NI_copy_Error_Errno(ipo1);
        return NULL;
    }

    version = NI_hv_get_iv(ipo1, "ipversion", 9);
    iplen = NI_iplengths(version);
    binbuf[iplen] = '\0';
    buf[0] = '\0';

    res = NI_ip_bintoip(binbuf, version, buf);
    if (!res) {
        return NULL;
    }

    hash  = newHV();
    ref   = newRV_noinc((SV*) hash);
    stash = gv_stashpv("Net::IP::XS", 1);
    sv_bless(ref, stash);
    res = NI_set(ref, buf, version);
    if (!res) {
        return NULL;
    }

    return ref;
}
Ejemplo n.º 17
0
void set_up_debug_sv(const char* name) {
	SV* tie_obj;
	HV* tie_obj_stash;
	
	// create an sv and make it a reference to another (new and empty) sv
	tie_obj = newSV(0);
	newSVrv(tie_obj, NULL);
		
	// bless the reference into the name'd class
	tie_obj_stash = gv_stashpv(name, TRUE);
	sv_bless(tie_obj, tie_obj_stash);
		
	// tie the blessed object to the name'd scalar
	sv_magic(get_sv(name, 1), tie_obj, PERL_MAGIC_tiedscalar, NULL, 0);
}
Ejemplo n.º 18
0
static void
tie_it(pTHX_ const char name, UV flag, HV *const stash)
{
    GV *const gv = gv_fetchpvn(&name, 1, GV_ADDMULTI|GV_NOTQUAL, SVt_PVHV);
    HV *const hv = GvHV(gv);
    SV *rv = newSV_type(SVt_RV);

    SvRV_set(rv, newSVuv(flag));
    SvROK_on(rv);
    sv_bless(rv, stash);

    sv_unmagic((SV *)hv, PERL_MAGIC_tied);
    sv_magic((SV *)hv, rv, PERL_MAGIC_tied, NULL, 0);
    SvREFCNT_dec(rv); /* As sv_magic increased it by one.  */
}
Ejemplo n.º 19
0
static void *
create_event_common(lcb_io_opt_t cbcio, int type)
{
    plcb_EVENT *cevent;
    plcb_IOPROCS *async;
    SV *initproc = NULL, *tmprv = NULL;
    async = (plcb_IOPROCS*) cbcio->v.v0.cookie;

    Newxz(cevent, 1, plcb_EVENT);
    cevent->pl_event = newAV();
    cevent->rv_event = newRV_noinc((SV*)cevent->pl_event);
    cevent->evtype = type;
    cevent->fd = -1;

    sv_bless(cevent->rv_event, gv_stashpv(PLCB_EVENT_CLASS, GV_ADD));
    av_store(cevent->pl_event, PLCB_EVIDX_OPAQUE, newSViv(PTR2IV(cevent)));
    av_store(cevent->pl_event, PLCB_EVIDX_FD, newSViv(-1));
    av_store(cevent->pl_event, PLCB_EVIDX_TYPE, newSViv(type));
    av_store(cevent->pl_event, PLCB_EVIDX_WATCHFLAGS, newSViv(0));

    tmprv = newRV_inc(*av_fetch(cevent->pl_event, PLCB_EVIDX_OPAQUE, 0));
    sv_bless(tmprv, gv_stashpv("Couchbase::IO::_CEvent", GV_ADD));
    SvREFCNT_dec(tmprv);


    if (type == PLCB_EVTYPE_IO) {
        initproc = async->cv_evinit;
    } else {
        initproc = async->cv_tminit;
    }

    if (initproc) {
        cb_args_noret(initproc, 0, 2, async->userdata, cevent->rv_event);
    }
    return cevent;
}
Ejemplo n.º 20
0
void p5_rebless_object(PerlInterpreter *my_perl, SV *obj, char *package, IV i) {
    PERL_SET_CONTEXT(my_perl);
    {
        SV * const inst = SvRV(obj);
        HV *stash = gv_stashpv(package, GV_ADD);
        if (stash == NULL)
            croak("Perl6::Object not found!? Forgot to call init_callbacks?");
        (void)sv_bless(obj, stash);

        _perl6_magic priv;

        /* set up magic */
        priv.key = PERL6_MAGIC_KEY;
        priv.index = i;
        sv_magicext(inst, inst, PERL_MAGIC_ext, &p5_inline_mg_vtbl, (char *) &priv, sizeof(priv));
    }
}
Ejemplo n.º 21
0
MP_INLINE SV *modperl_newSVsv_obj(pTHX_ SV *stashsv, SV *obj)
{
    SV *newobj;

    if (!obj) {
        obj = stashsv;
        stashsv = (SV *)NULL;
    }

    newobj = newSVsv(obj);

    if (stashsv) {
        HV *stash = gv_stashsv(stashsv, TRUE);
        return sv_bless(newobj, stash);
    }

    return newobj;
}
Ejemplo n.º 22
0
SV *
g_hash_table_to_hashref_property(GHashTable *hash)
{
    HV *hv;
    HV *stash;
    SV *tie;

    hv = newHV();
    tie = newRV_noinc((SV*)newHV());
    stash = gv_stashpv("Amanda::Config::FoldingHash", GV_ADD);
    sv_bless(tie, stash);
    hv_magic(hv, (GV*)tie, PERL_MAGIC_tied);

    hv = (HV *)sv_2mortal((SV *)hv);
    g_hash_table_foreach(hash, foreach_fn_property, hv);

    return newRV((SV *)hv);
}
Ejemplo n.º 23
0
static void
Encode_XSEncoding(pTHX_ encode_t *enc)
{
 dSP;
 HV *stash = gv_stashpv("Encode::XS", TRUE);
 SV *sv    = sv_bless(newRV_noinc(newSViv(PTR2IV(enc))),stash);
 int i = 0;
 PUSHMARK(sp);
 XPUSHs(sv);
 while (enc->name[i])
  {
   const char *name = enc->name[i++];
   XPUSHs(sv_2mortal(newSVpvn(name,strlen(name))));
  }
 PUTBACK;
 call_pv("Encode::define_encoding",G_DISCARD);
 SvREFCNT_dec(sv);
}
Ejemplo n.º 24
0
void store_self(pTHX, mthread* thread) {
	SV *thread_sv, *self;
	AV* message_cache;

	thread_sv = newSV_type(SVt_PV);
	SvPVX(thread_sv) = (char*) thread;
	SvCUR(thread_sv) = sizeof(mthread);
	SvLEN(thread_sv) = 0;
	SvPOK_only(thread_sv);
	SvREADONLY_on(thread_sv);
	hv_store(PL_modglobal, "threads::lite::thread", 21, thread_sv, 0);

	self = newRV_noinc(newSVuv(thread->id));
	sv_bless(self, gv_stashpv("threads::lite::tid", TRUE));
	hv_store(PL_modglobal, "threads::lite::self", 19, self, 0);

	message_cache = newAV();
	hv_store(PL_modglobal, "threads::lite::message_cache", 28, (SV*)message_cache, 0);
	thread->cache = message_cache;
}
Ejemplo n.º 25
0
static void
create_callback (GtkCellLayoutDataFunc func,
                 gpointer              data,
                 GtkDestroyNotify      destroy,
		 SV                  **code_return,
                 SV                  **data_return)
{
	HV *stash;
	SV *code_sv, *data_sv;
	Gtk2PerlCellLayoutDataFunc *wrapper;

	wrapper = g_new0 (Gtk2PerlCellLayoutDataFunc, 1);
	wrapper->func = func;
	wrapper->data = data;
	wrapper->destroy = destroy;
	data_sv = newSViv (PTR2IV (wrapper));

	stash = gv_stashpv ("Gtk2::CellLayout::DataFunc", TRUE);
	code_sv = sv_bless (newRV (data_sv), stash);

	*code_return = code_sv;
	*data_return = data_sv;
}
Ejemplo n.º 26
0
SV * newSVGdkEvent(GdkEvent * e)
{
	HV * h;
	GdkEvent * e2;
	SV * r;
	int n;
	
	if (!e)
		return newSVsv(&PL_sv_undef);
 
 
        h = newHV();
        /*r = newSVMiscRef(e, "Gtk::Gdk::Event", &n);*/

	/*h = (HV*)SvRV(r);*/
	r = newRV((SV*)h);
	SvREFCNT_dec(h);

	sv_bless(r, gv_stashpv("Gtk::Gdk::Event", FALSE));
 	
	e2 = gdk_event_copy(e);
	
	hv_store(h, "_ptr", 4, newSViv((int)e2), 0);
	
	/*printf("Turning GdkEvent %d, type %d, into SV %d, ptr %d\n", e, e->type, r, e2);*/
	
	hv_store(h, "type", 4, newSVGdkEventType(e->type), 0);
	hv_store(h, "window", 6, newSVGdkWindow(e->any.window), 0);
	switch (e->type) {
	case GDK_EXPOSE:
		hv_store(h, "area", 4, newSVGdkRectangle(&e->expose.area), 0);
		hv_store(h, "count", 5, newSViv(e->expose.count), 0);
		break;
	case GDK_MOTION_NOTIFY:
		hv_store(h, "is_hint", 7, newSViv(e->motion.is_hint), 0);
		hv_store(h, "x", 1, newSVnv(e->motion.x), 0);
		hv_store(h, "y", 1, newSVnv(e->motion.y), 0);
		hv_store(h, "pressure", 8, newSVnv(e->motion.pressure), 0);
		hv_store(h, "xtilt", 5, newSVnv(e->motion.xtilt), 0);
		hv_store(h, "ytilt", 5, newSVnv(e->motion.ytilt), 0);
		hv_store(h, "time", 4, newSViv(e->motion.time), 0);
		hv_store(h, "state", 5, newSViv(e->motion.state), 0);
		hv_store(h, "source", 6, newSVGdkInputSource(e->motion.source), 0);
		hv_store(h, "deviceid", 8, newSViv(e->motion.deviceid), 0);
		break;
	case GDK_BUTTON_PRESS:
	case GDK_2BUTTON_PRESS:
	case GDK_3BUTTON_PRESS:
	case GDK_BUTTON_RELEASE:
		hv_store(h, "x", 1, newSViv(e->button.x), 0);
		hv_store(h, "y", 1, newSViv(e->button.y), 0);
		hv_store(h, "time", 4, newSViv(e->button.time), 0);
		hv_store(h, "pressure", 8, newSVnv(e->motion.pressure), 0);
		hv_store(h, "xtilt", 5, newSVnv(e->motion.xtilt), 0);
		hv_store(h, "ytilt", 5, newSVnv(e->motion.ytilt), 0);
		hv_store(h, "state", 5, newSViv(e->button.state), 0);
		hv_store(h, "button", 6, newSViv(e->button.button), 0);
		hv_store(h, "source", 6, newSVGdkInputSource(e->motion.source), 0);
		hv_store(h, "deviceid", 8, newSViv(e->motion.deviceid), 0);
		break;
	case GDK_KEY_PRESS:
	case GDK_KEY_RELEASE:
		hv_store(h, "time", 4, newSViv(e->key.time), 0);
		hv_store(h, "state", 5, newSViv(e->key.state), 0);
		hv_store(h, "keyval", 6, newSViv(e->key.keyval), 0);
		break;
	case GDK_FOCUS_CHANGE:
		hv_store(h, "in", 2, newSViv(e->focus_change.in), 0);
		break;
	case GDK_ENTER_NOTIFY:
	case GDK_LEAVE_NOTIFY:
		hv_store(h, "window", 6, newSVGdkWindow(e->crossing.window), 0);
		hv_store(h, "subwindow", 9, newSVGdkWindow(e->crossing.subwindow), 0);
		hv_store(h, "detail", 6, newSVGdkNotifyType(e->crossing.detail), 0);
		break;
	case GDK_CONFIGURE:
		hv_store(h, "x", 1, newSViv(e->configure.x), 0);
		hv_store(h, "y", 1, newSViv(e->configure.y), 0);
		hv_store(h, "width", 5, newSViv(e->configure.width), 0);
		hv_store(h, "height", 6, newSViv(e->configure.height), 0);
		break;
	case GDK_PROPERTY_NOTIFY:
		hv_store(h, "time", 4, newSViv(e->property.time), 0);
		hv_store(h, "state", 5, newSViv(e->property.state), 0);
		hv_store(h, "atom", 4, newSVGdkAtom(e->property.atom), 0);
		break;
	case GDK_SELECTION_CLEAR:
	case GDK_SELECTION_REQUEST:
	case GDK_SELECTION_NOTIFY:
		hv_store(h, "requestor", 9, newSViv(e->selection.requestor), 0);
		hv_store(h, "time", 4, newSViv(e->selection.time), 0);
		hv_store(h, "selection", 9, newSVGdkAtom(e->selection.selection), 0);
		hv_store(h, "property", 8, newSVGdkAtom(e->selection.property), 0);
		break;
	case GDK_PROXIMITY_IN:
	case GDK_PROXIMITY_OUT:
		hv_store(h, "time", 4, newSViv(e->proximity.time), 0);
		hv_store(h, "source", 6, newSVGdkInputSource(e->motion.source), 0);
		hv_store(h, "deviceid", 8, newSViv(e->motion.deviceid), 0);
		break;
		
	}
	
	return r;
}
Ejemplo n.º 27
0
static SV *bless(pTHX_ HV *self, const char *classname)
{
	HV *stash = (HV *)gv_stashpv(classname, strlen(classname) + 1);
	return sv_bless(new_Ref(self), stash);
}
Ejemplo n.º 28
0
int   perl_trapd_handler( netsnmp_pdu           *pdu,
                          netsnmp_transport     *transport,
                          netsnmp_trapd_handler *handler)
{
    trapd_cb_data *cb_data;
    SV *pcallback;
    netsnmp_variable_list *vb;
    netsnmp_oid *o;
    SV *arg;
    SV *rarg;
    SV **tmparray;
    int i, c = 0;
    u_char *outbuf;
    size_t ob_len = 0, oo_len = 0;
    AV *varbinds;
    HV *pduinfo;

    dSP;
    ENTER;
    SAVETMPS;

    if (!pdu || !handler)
        return 0;

    /* nuke v1 PDUs */
    if (pdu->command == SNMP_MSG_TRAP)
        pdu = convert_v1pdu_to_v2(pdu);

    cb_data = handler->handler_data;
    if (!cb_data || !cb_data->perl_cb)
        return 0;

    pcallback = cb_data->perl_cb;

    /* get PDU related info */
    pduinfo = newHV();
#define STOREPDU(n, v) hv_store(pduinfo, n, strlen(n), v, 0)
#define STOREPDUi(n, v) STOREPDU(n, newSViv(v))
#define STOREPDUs(n, v) STOREPDU(n, newSVpv(v, 0))
    STOREPDUi("version", pdu->version);
    STOREPDUs("notificationtype", ((pdu->command == SNMP_MSG_INFORM) ? "INFORM":"TRAP"));
    STOREPDUi("requestid", pdu->reqid);
    STOREPDUi("messageid", pdu->msgid);
    STOREPDUi("transactionid", pdu->transid);
    STOREPDUi("errorstatus", pdu->errstat);
    STOREPDUi("errorindex", pdu->errindex);
    if (pdu->version == 3) {
        STOREPDUi("securitymodel", pdu->securityModel);
        STOREPDUi("securitylevel", pdu->securityLevel);
        STOREPDU("contextName",
                 newSVpv(pdu->contextName, pdu->contextNameLen));
        STOREPDU("contextEngineID",
                 newSVpv(pdu->contextEngineID,
                                    pdu->contextEngineIDLen));
        STOREPDU("securityEngineID",
                 newSVpv(pdu->securityEngineID,
                                    pdu->securityEngineIDLen));
        STOREPDU("securityName",
                 newSVpv(pdu->securityName, pdu->securityNameLen));
    } else {
        STOREPDU("community",
                 newSVpv(pdu->community, pdu->community_len));
    }

    if (transport && transport->f_fmtaddr) {
        char *tstr = transport->f_fmtaddr(transport, pdu->transport_data,
                                          pdu->transport_data_length);
        STOREPDUs("receivedfrom", tstr);
        free(tstr);
    }


    /*
     * collect OID objects in a temp array first
     */
    /* get VARBIND related info */
    i = count_varbinds(pdu->variables);
    tmparray = malloc(sizeof(*tmparray) * i);

    for(vb = pdu->variables; vb; vb = vb->next_variable) {

        /* get the oid */
        o = SNMP_MALLOC_TYPEDEF(netsnmp_oid);
        o->name = o->namebuf;
        o->len = vb->name_length;
        memcpy(o->name, vb->name, vb->name_length * sizeof(oid));

#undef CALL_EXTERNAL_OID_NEW

#ifdef CALL_EXTERNAL_OID_NEW
        PUSHMARK(sp);

        rarg = sv_2mortal(newSViv((IV) 0));
        arg = sv_2mortal(newSVrv(rarg, "netsnmp_oidPtr"));
        sv_setiv(arg, (IV) o);
        XPUSHs(rarg);

        PUTBACK;
        i = perl_call_pv("NetSNMP::OID::newwithptr", G_SCALAR);
        SPAGAIN;

        if (i != 1) {
            snmp_log(LOG_ERR, "unhandled OID error.\n");
            /* ack XXX */
        }
        /* get the value */
        tmparray[c++] = POPs;
        SvREFCNT_inc(tmparray[c-1]);
        PUTBACK;
#else /* build it and bless ourselves */
        {
            HV *hv = newHV();
            SV *rv = newRV_noinc((SV *) hv);
            SV *rvsub = newRV_noinc((SV *) newSViv((UV) o));
            SV *sv;
            rvsub = sv_bless(rvsub, gv_stashpv("netsnmp_oidPtr", 1));
            hv_store(hv, "oidptr", 6,  rvsub, 0);
            rv = sv_bless(rv, gv_stashpv("NetSNMP::OID", 1));
            tmparray[c++] = rv;
        }
        
#endif /* build oid ourselves */
    }

    /*
     * build the varbind lists
     */
    varbinds = newAV();
    for(vb = pdu->variables, i = 0; vb; vb = vb->next_variable, i++) {
        /* push the oid */
        AV *vba;
        vba = newAV();


        /* get the value */
        outbuf = NULL;
        ob_len = 0;
        oo_len = 0;
	sprint_realloc_by_type(&outbuf, &ob_len, &oo_len, 1,
                               vb, 0, 0, 0);

        av_push(vba,tmparray[i]);
        av_push(vba,newSVpvn(outbuf, oo_len));
        free(outbuf);
        av_push(vba,newSViv(vb->type));
        av_push(varbinds, (SV *) newRV_noinc((SV *) vba));
    }

    PUSHMARK(sp);

    /* store the collected information on the stack */
    XPUSHs(sv_2mortal(newRV_noinc((SV*) pduinfo)));
    XPUSHs(sv_2mortal(newRV_noinc((SV*) varbinds)));

    /* put the stack back in order */
    PUTBACK;

    /* actually call the callback function */
    if (SvTYPE(pcallback) == SVt_PVCV) {
        perl_call_sv(pcallback, G_DISCARD);
        /* XXX: it discards the results, which isn't right */
    } else if (SvROK(pcallback) && SvTYPE(SvRV(pcallback)) == SVt_PVCV) {
        /* reference to code */
        perl_call_sv(SvRV(pcallback), G_DISCARD);
    } else {
        snmp_log(LOG_ERR, " tried to call a perl function but failed to understand its type: (ref = %x, svrok: %lu, SVTYPE: %lu)\n", (uintptr_t)pcallback, SvROK(pcallback), SvTYPE(pcallback));
    }

#ifdef DUMPIT
    fprintf(stderr, "DUMPDUMPDUMPDUMPDUMPDUMP\n");
    sv_dump(pduinfo);
    fprintf(stderr, "--------------------\n");
    sv_dump(varbinds);
#endif
    
    /* svREFCNT_dec((SV *) pduinfo); */
#ifdef NOT_THIS
    {
        SV *vba;
        while(vba = av_pop(varbinds)) {
            av_undef((AV *) vba);
        }
    }
    av_undef(varbinds);
#endif    
    free(tmparray);

    /* Not needed because of the G_DISCARD flag (I think) */
    /* SPAGAIN; */
    /* PUTBACK; */
#ifndef __x86_64__
    FREETMPS; /* FIXME: known to cause a segfault on x86-64 */
#endif
    LEAVE;
    return NETSNMPTRAPD_HANDLER_OK;
}
Ejemplo n.º 29
0
static ngx_int_t
ngx_http_perl_call_handler(pTHX_ ngx_http_request_t *r, HV *nginx, SV *sub,
    SV **args, ngx_str_t *handler, ngx_str_t *rv)
{
    SV                *sv;
    int                n, status;
    char              *line;
    STRLEN             len, n_a;
    ngx_str_t          err;
    ngx_uint_t         i;
    ngx_connection_t  *c;

    dSP;

    status = 0;

    ENTER;
    SAVETMPS;

    PUSHMARK(sp);

    sv = sv_2mortal(sv_bless(newRV_noinc(newSViv(PTR2IV(r))), nginx));
    XPUSHs(sv);

    if (args) {
        EXTEND(sp, (intptr_t) args[0]);

        for (i = 1; i <= (ngx_uint_t) args[0]; i++) {
            PUSHs(sv_2mortal(args[i]));
        }
    }

    PUTBACK;

    c = r->connection;

    n = call_sv(sub, G_EVAL);

    SPAGAIN;

    if (c->destroyed) {
        PUTBACK;

        FREETMPS;
        LEAVE;

        return NGX_DONE;
    }

    if (n) {
        if (rv == NULL) {
            status = POPi;

            ngx_log_debug1(NGX_LOG_DEBUG_HTTP, c->log, 0,
                           "call_sv: %d", status);

        } else {
            line = SvPVx(POPs, n_a);
            rv->len = n_a;

            rv->data = ngx_pnalloc(r->pool, n_a);
            if (rv->data == NULL) {
                return NGX_ERROR;
            }

            ngx_memcpy(rv->data, line, n_a);
        }
    }

    PUTBACK;

    FREETMPS;
    LEAVE;

    /* check $@ */

    if (SvTRUE(ERRSV)) {

        err.data = (u_char *) SvPV(ERRSV, len);
        for (len--; err.data[len] == LF || err.data[len] == CR; len--) {
            /* void */
        }
        err.len = len + 1;

        ngx_log_error(NGX_LOG_ERR, c->log, 0,
                      "call_sv(\"%V\") failed: \"%V\"", handler, &err);

        if (rv) {
            return NGX_ERROR;
        }

        return NGX_HTTP_INTERNAL_SERVER_ERROR;
    }

    if (n != 1) {
        ngx_log_error(NGX_LOG_ALERT, c->log, 0,
                      "call_sv(\"%V\") returned %d results", handler, n);
        status = NGX_OK;
    }

    if (rv) {
        return NGX_OK;
    }

    return (ngx_int_t) status;
}
Ejemplo n.º 30
0
void _mpack_item(SV *res, SV *o)
{
	size_t len, res_len, new_len;
	char *s, *res_s;
	res_s = SvPVbyte(res, res_len);
	unsigned i;

	if (!SvOK(o)) {
		new_len = res_len + mp_sizeof_nil();
		res_s = SvGROW(res, new_len);
		SvCUR_set(res, new_len);
		mp_encode_nil(res_s + res_len);
		return;
	}

	if (SvROK(o)) {
		o = SvRV(o);
		if (SvOBJECT(o)) {
			SvGETMAGIC(o);
			HV *stash = SvSTASH(o);
			GV *mtd = gv_fetchmethod_autoload(stash, "msgpack", 0);
			if (!mtd)
				croak("Object has no method 'msgpack'");
			dSP;
			ENTER;
			SAVETMPS;
			PUSHMARK(SP);
			XPUSHs (sv_bless (sv_2mortal (newRV_inc(o)), stash));
			PUTBACK;
			call_sv((SV *)GvCV(mtd), G_SCALAR);
			SPAGAIN;

			SV *pkt = POPs;

			if (!SvOK(pkt))
				croak("O->msgpack returned undef");

			s = SvPV(pkt, len);

			new_len = res_len + len;
			res_s = SvGROW(res, new_len);
			SvCUR_set(res, new_len);
			memcpy(res_s + res_len, s, len);

			PUTBACK;
			FREETMPS;
			LEAVE;

			return;
		}

		switch(SvTYPE(o)) {
			case SVt_PVAV: {
				AV *a = (AV *)o;
				len = av_len(a) + 1;
				new_len = res_len + mp_sizeof_array(len);
				res_s = SvGROW(res, new_len);
				SvCUR_set(res, new_len);
				mp_encode_array(res_s + res_len, len);

				for (i = 0; i < len; i++) {
					SV **item = av_fetch(a, i, 0);
					if (!item)
						_mpack_item(res, 0);
					else
						_mpack_item(res, *item);
				}

				break;
			}
			case SVt_PVHV: {
				HV *h = (HV *)o;
				len = hv_iterinit(h);
				new_len = res_len + mp_sizeof_map(len);
				res_s = SvGROW(res, new_len);
				SvCUR_set(res, new_len);
				mp_encode_map(res_s + res_len, len);

				for (;;) {
					HE * iter = hv_iternext(h);
					if (!iter)
						break;

					SV *k = hv_iterkeysv(iter);
					SV *v = HeVAL(iter);
					_mpack_item(res, k);
					_mpack_item(res, v);

				}

				break;
			}

			default:
				croak("Can't serialize reference");
		}
		return;
	}

	switch(SvTYPE(o)) {
		case SVt_PV:
		case SVt_PVIV:
		case SVt_PVNV:
		case SVt_PVMG:
		case SVt_REGEXP:
			if (!looks_like_number(o)) {
				s = SvPV(o, len);
				new_len = res_len + mp_sizeof_str(len);
				res_s = SvGROW(res, new_len);
				SvCUR_set(res, new_len);
				mp_encode_str(res_s + res_len, s, len);
				break;
			}

		case SVt_NV: {
			NV v = SvNV(o);
			IV iv = (IV)v;

			if (v != iv) {
				new_len = res_len + mp_sizeof_double(v);
				res_s = SvGROW(res, new_len);
				SvCUR_set(res, new_len);
				mp_encode_double(res_s + res_len, v);
				break;
			}
		}
		case SVt_IV: {
			IV v = SvIV(o);
			if (v >= 0) {
				new_len = res_len + mp_sizeof_uint(v);
				res_s = SvGROW(res, new_len);
				SvCUR_set(res, new_len);
				mp_encode_uint(res_s + res_len, v);
			} else {
				new_len = res_len + mp_sizeof_int(v);
				res_s = SvGROW(res, new_len);
				SvCUR_set(res, new_len);
				mp_encode_int(res_s + res_len, v);
			}
			break;
		}
		default:
			croak("Internal msgpack error %d", SvTYPE(o));
	}
}