PPCODE results from the CPAN

PPCODE

PerlQt

view release on metacpan or search on metacpan

    AV* ar = newAV();
    RETVAL = newRV_noinc((SV*)ar);
    for(int i=0; s[i] ; i++)
    {
	SV *item = newSViv((IV)s[i]);
	if(!av_store(ar, (I32)i, item))
	    SvREFCNT_dec( item );
    }
    OUTPUT: 
    RETVAL

void
STORE(obj,sv)
   SV* obj
   SV* sv
   CODE:
    if (!SvROK(obj))
        croak("?");
    IV tmp = SvIV((SV*)SvRV(obj));
    QRgb *s = (QRgb*) tmp;
    if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV ||
	av_len((AV*)SvRV(sv)) < 0) {
	 s = new QRgb[1];
	 s[0] = 0; 
	 sv_setref_pv(obj, "Qt::_internal::QRgbStar", (void*)s);
	 return;
    }
    AV *list = (AV*)SvRV(sv);
    int count = av_len(list);
    s = new QRgb[count + 2];
    int i;
    for(i = 0; i <= count; i++) {
	SV **item = av_fetch(list, i, 0);
	if(!item || !SvOK(*item)) {
	    s[i] = 0;
	    continue;
	}
	s[i] = SvIV(*item);
    }
    s[i] = 0;
    sv_setref_pv(obj, "Qt::_internal::QRgbStar", (void*)s); 

void
DESTROY(obj)
    SV* obj
    CODE:
    if (!SvROK(obj))
        croak("?");
    IV tmp = SvIV((SV*)SvRV(obj));
    QRgb *s = (QRgb*) tmp;
    delete[] s;

# --------------- XSUBS for Qt::_internal::* helpers  ----------------


MODULE = Qt   PACKAGE = Qt::_internal
PROTOTYPES: DISABLE

void
getMethStat()
    PPCODE:
    XPUSHs(sv_2mortal(newSViv((int)methcache->size())));
    XPUSHs(sv_2mortal(newSViv((int)methcache->count())));

void
getClassStat()
    PPCODE:
    XPUSHs(sv_2mortal(newSViv((int)classcache->size())));
    XPUSHs(sv_2mortal(newSViv((int)classcache->count())));

void
getIsa(classId)
    int classId
    PPCODE:
    Smoke::Index *parents =
	qt_Smoke->inheritanceList +
	qt_Smoke->classes[classId].parents;
    while(*parents)
	XPUSHs(sv_2mortal(newSVpv(qt_Smoke->classes[*parents++].className, 0)));

void
dontRecurse()
    CODE:
    avoid_fetchmethod = true;

void *
sv_to_ptr(sv)
    SV* sv

void *
allocateMocArguments(count)
    int count
    CODE:
    RETVAL = (void*)new MocArgument[count + 1];
    OUTPUT:
    RETVAL

void
setMocType(ptr, idx, name, static_type)
    void *ptr
    int idx
    char *name
    char *static_type
    CODE:
    Smoke::Index typeId = qt_Smoke->idType(name);
    if(!typeId) XSRETURN_NO;
    MocArgument *arg = (MocArgument*)ptr;
    arg[idx].st.set(qt_Smoke, typeId);
    if(!strcmp(static_type, "ptr"))
	arg[idx].argType = xmoc_ptr;
    else if(!strcmp(static_type, "bool"))
	arg[idx].argType = xmoc_bool;
    else if(!strcmp(static_type, "int"))
	arg[idx].argType = xmoc_int;
    else if(!strcmp(static_type, "double"))
	arg[idx].argType = xmoc_double;
    else if(!strcmp(static_type, "char*"))
	arg[idx].argType = xmoc_charstar;
    else if(!strcmp(static_type, "QString"))
	arg[idx].argType = xmoc_QString;
    XSRETURN_YES;

void
installsignal(name)
    char *name
    CODE:
    char *file = __FILE__;
    newXS(name, XS_signal, file);

void
installqt_invoke(name)
    char *name
    CODE:
    char *file = __FILE__;

PerlQt/Qt.xs view on Meta::CPAN

isValidAllocatedPointer(obj)
    SV *obj
    CODE:
    RETVAL = 0;
    smokeperl_object *o = sv_obj_info(obj);
    if(o && o->ptr && o->allocated)
	RETVAL = 1;
    OUTPUT:
    RETVAL

SV*
findAllocatedObjectFor(obj)
    SV *obj
    CODE:
    RETVAL = &PL_sv_undef;
    smokeperl_object *o = sv_obj_info(obj);
    SV *ret;
    if(o && o->ptr && (ret = getPointerObject(o->ptr)))
        RETVAL = ret;
    OUTPUT:
    RETVAL

SV *
getGV(cv)
    SV *cv
    CODE:
    RETVAL = (SvROK(cv) && (SvTYPE(SvRV(cv))==SVt_PVCV) ?
              SvREFCNT_inc(CvGV((CV*)SvRV(cv))) : &PL_sv_undef);
    OUTPUT:
    RETVAL

int
idClass(name)
    char *name
    CODE:
    RETVAL = qt_Smoke->idClass(name);
    OUTPUT:
    RETVAL

int
idMethodName(name)
    char *name
    CODE:
    RETVAL = qt_Smoke->idMethodName(name);
    OUTPUT:
    RETVAL

int
idMethod(idclass, idmethodname)
    int idclass
    int idmethodname
    CODE:
    RETVAL = qt_Smoke->idMethod(idclass, idmethodname);
    OUTPUT:
    RETVAL

void
findMethod(c, name)
    char *c
    char *name
    PPCODE:
    Smoke::Index meth = qt_Smoke->findMethod(c, name);
//    printf("DAMNIT on %s::%s => %d\n", c, name, meth);
    if(!meth) {
	// empty list
    } else if(meth > 0) {
	Smoke::Index i = qt_Smoke->methodMaps[meth].method;
	if(!i) {		// shouldn't happen
	    croak("Corrupt method %s::%s", c, name);
	} else if(i > 0) {	// single match
	    PUSHs(sv_2mortal(newSViv(
		(IV)qt_Smoke->methodMaps[meth].method
	    )));
	} else {		// multiple match
	    i = -i;		// turn into ambiguousMethodList index
	    while(qt_Smoke->ambiguousMethodList[i]) {
		PUSHs(sv_2mortal(newSViv(
		    (IV)qt_Smoke->ambiguousMethodList[i]
		)));
		i++;
	    }
	}
    }

void
findMethodFromIds(idclass, idmethodname)
    int idclass
    int idmethodname
    PPCODE:
    Smoke::Index meth = qt_Smoke->findMethod(idclass, idmethodname);
    if(!meth) {
	// empty list
    } else if(meth > 0) {
	Smoke::Index i = qt_Smoke->methodMaps[meth].method;
	if(i >= 0) {	// single match
	    PUSHs(sv_2mortal(newSViv((IV)i)));
	} else {		// multiple match
	    i = -i;		// turn into ambiguousMethodList index
	    while(qt_Smoke->ambiguousMethodList[i]) {
		PUSHs(sv_2mortal(newSViv(
		    (IV)qt_Smoke->ambiguousMethodList[i]
		)));
		i++;
	    }
	}
    }

# findAllMethods(classid [, startingWith]) : returns { "mungedName" => [index in methods, ...], ... }

HV*
findAllMethods(classid, ...)
    SV* classid
    CODE:
    RETVAL=newHV();
    if(SvIOK(classid)) {
        Smoke::Index c = (Smoke::Index) SvIV(classid);
        char * pat = 0L;
        if(items > 1 && SvPOK(ST(1)))
            pat = SvPV_nolen(ST(1));
        Smoke::Index imax = qt_Smoke->numMethodMaps;
        Smoke::Index imin = 0, icur = -1, methmin = 0, methmax = 0;
        int icmp = -1;
        while(imax >= imin) {
            icur = (imin + imax) / 2;
            icmp = qt_Smoke->leg(qt_Smoke->methodMaps[icur].classId, c);
            if(!icmp) {
                Smoke::Index pos = icur;
                while(icur && qt_Smoke->methodMaps[icur-1].classId == c)
                    icur --;
                methmin = icur;
                icur = pos;
                while(icur < imax && qt_Smoke->methodMaps[icur+1].classId == c)
                    icur ++;
                methmax = icur;
                break;
            }
            if (icmp > 0)
		imax = icur - 1;
	    else
		imin = icur + 1;
        }
        if(!icmp) {
            for(Smoke::Index i=methmin ; i <= methmax ; i++) {
                Smoke::Index m = qt_Smoke->methodMaps[i].name;
                if(!pat || !strncmp(qt_Smoke->methodNames[m], pat, strlen(pat))) {
                    Smoke::Index ix= qt_Smoke->methodMaps[i].method;
                    AV* meths = newAV();
                    if(ix >= 0) {	// single match
                        av_push(meths, newSViv((IV)ix));

PerlQt/Qt.xs view on Meta::CPAN

        AV *methods = (AV*)SvRV(rmeths);
        SV *errmsg = newSVpvf("");
        for(int i = 0; i <= av_len(methods); i++) {
                sv_catpv(errmsg, "\t");
                IV id = SvIV(*(av_fetch(methods, i, 0)));
                Smoke::Method &meth = qt_Smoke->methods[id];
                const char *tname = qt_Smoke->types[meth.ret].name;
                if(meth.flags & Smoke::mf_static) sv_catpv(errmsg, "static ");
                sv_catpvf(errmsg, "%s ", (tname ? tname:"void"));
                sv_catpvf(errmsg, "%s::%s(", qt_Smoke->classes[meth.classId].className, qt_Smoke->methodNames[meth.name]);
                for(int i = 0; i < meth.numArgs; i++) {
                        if(i) sv_catpv(errmsg, ", ");
                        tname = qt_Smoke->types[qt_Smoke->argumentList[meth.args+i]].name;
                        sv_catpv(errmsg, (tname ? tname:"void"));
                }
                sv_catpv(errmsg, ")");
                if(meth.flags & Smoke::mf_const) sv_catpv(errmsg, " const");
                sv_catpv(errmsg, "\n");
        }
        RETVAL=errmsg;
    }
    else
        RETVAL=newSVpvf("");
    OUTPUT:
    RETVAL

SV *
catArguments(r_args)
    SV* r_args
    CODE:
    RETVAL=newSVpvf("");
    if(SvROK(r_args) && SvTYPE(SvRV(r_args)) == SVt_PVAV) {
        AV* args=(AV*)SvRV(r_args);
        for(int i = 0; i <= av_len(args); i++) {
            SV **arg=av_fetch(args, i, 0);
	    if(i) sv_catpv(RETVAL, ", ");
	    if(!arg || !SvOK(*arg)) {
		sv_catpv(RETVAL, "undef");
	    } else if(SvROK(*arg)) {
		smokeperl_object *o = sv_obj_info(*arg);
		if(o)
		    sv_catpv(RETVAL, o->smoke->className(o->classId));
		else
		    sv_catsv(RETVAL, *arg);
	    } else {
		bool isString = SvPOK(*arg);
		STRLEN len;
		char *s = SvPV(*arg, len);
		if(isString) sv_catpv(RETVAL, "'");
		sv_catpvn(RETVAL, s, len > 10 ? 10 : len);
		if(len > 10) sv_catpv(RETVAL, "...");
		if(isString) sv_catpv(RETVAL, "'");
	    }
	}
    }
    OUTPUT:
    RETVAL

SV *
callMethod(...)
    PPCODE:
    if(_current_method) {
	MethodCall c(qt_Smoke, _current_method, &ST(0), items);
	c.next();
	SV *ret = c.var();
	SvREFCNT_inc(ret);
	PUSHs(sv_2mortal(ret));
    } else
	PUSHs(sv_newmortal());

bool
isObject(obj)
    SV *obj
    CODE:
    RETVAL = sv_to_ptr(obj) ? TRUE : FALSE;
    OUTPUT:
    RETVAL

void
setCurrentMethod(meth)
    int meth
    CODE:
    // FIXME: damn, this is lame, and it doesn't handle ambiguous methods
    _current_method = meth;  //qt_Smoke->methodMaps[meth].method;

SV *
getClassList()
    CODE:
    AV *av = newAV();
    for(int i = 1; i <= qt_Smoke->numClasses; i++) {
//printf("%s => %d\n", qt_Smoke->classes[i].className, i);
	av_push(av, newSVpv(qt_Smoke->classes[i].className, 0));
//	hv_store(hv, qt_Smoke->classes[i].className, 0, newSViv(i), 0);
    }
    RETVAL = newRV((SV*)av);
    OUTPUT:
    RETVAL

void
installthis(package)
    char *package
    CODE:
    if(!package) XSRETURN_EMPTY;
    char *name = new char[strlen(package) + 7];
    char *file = __FILE__;
    strcpy(name, package);
    strcat(name, "::this");
    // *{ $name } = sub () : lvalue;
    CV *thissub = newXS(name, XS_this, file);
    sv_setpv((SV*)thissub, "");    // sub this () : lvalue;
    delete[] name;

void
installattribute(package, name)
    char *package
    char *name
    CODE:
    if(!package || !name) XSRETURN_EMPTY;
    char *attr = new char[strlen(package) + strlen(name) + 3];
    sprintf(attr, "%s::%s", package, name);
    char *file = __FILE__;

( run in 1.199 second using v1.01-cache-2.11-cpan-5511b514fd6 )