/* vim: set expandtab shiftwidth=4 softtabstop=4 cinoptions='\:2=2': */ #ifdef __cplusplus extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "Python.h" #include "util.h" #ifdef __cplusplus } #endif MGVTBL inline_mg_vtbl = { 0x0, 0x0, 0x0, 0x0, &free_inline_py_obj, 0x0, 0x0, 0x0 }; /************************************* * UTILITY FUNCTIONS * *************************************/ int free_inline_py_obj(pTHX_ SV* obj, MAGIC *mg) { if (mg && mg->mg_type == PERL_MAGIC_ext && Inline_Magic_Check(mg->mg_ptr)) { IV const iv = SvIV(obj); /*Printf(("free_inline_py_obj: %p, iv: %p, ob_prev: %p, ob_next: %p, refcnt: %i\n", obj, iv, ((PyObject *)iv)->_ob_prev, ((PyObject *)iv)->_ob_next, ((PyObject *)iv)->ob_refcnt)); */ /* _ob_prev and _ob_next are only available if Python is compiled with reference debugging enabled */ Printf(("free_inline_py_obj: %p, iv: %p, refcnt: %i\n", obj, iv, (int)Py_REFCNT(iv))); Py_XDECREF((PyObject *)iv); /* just in case */ } else { croak("ERROR: tried to free a non-Python object. Aborting."); } return 0; } PyObject * get_perl_pkg_subs(PyObject *package) { #if PY_MAJOR_VERSION >= 3 char * const pkg = PyBytes_AsString(package); #else char * const pkg = PyString_AsString(package); #endif PyObject * const retval = PyList_New(0); HV * const hash = perl_get_hv(pkg, 0); int const len = hv_iterinit(hash); int i; for (i=0; i<len; i++) { HE * const next = hv_iternext(hash); I32 n_a; char * const key = hv_iterkey(next,&n_a); char * const test = (char*)malloc((strlen(pkg) + strlen(key) + 1)*sizeof(char)); sprintf(test,"%s%s",pkg,key); if (perl_get_cv(test,0)) { #if PY_MAJOR_VERSION >= 3 PyList_Append(retval, PyUnicode_FromString(key)); #else PyList_Append(retval, PyString_FromString(key)); #endif } free(test); } return retval; } int perl_pkg_exists(char *base, char *pkg) { int retval = 0; HV * const hash = perl_get_hv(base,0); char * const fpkg = (char*)malloc((strlen(pkg) + strlen("::") + 1)*sizeof(char)); sprintf(fpkg,"%s::",pkg); Printf(("perl_pkg_exists: %s, %s --> %s\n", base, pkg, fpkg)); Printf(("perl_pkg_exists: hash=%p\n", hash)); if (hash && hv_exists(hash, fpkg, strlen(fpkg))) { /* here -- check if it's a package, not something else? */ retval = 1; } free(fpkg); return retval; } PyObject * perl_sub_exists(PyObject *package, PyObject *usub) { #if PY_MAJOR_VERSION >= 3 char * const pkg = PyBytes_AsString(package); char * const sub = PyBytes_AsString(usub); #else char * const pkg = PyString_AsString(package); char * const sub = PyString_AsString(usub); #endif PyObject * retval = Py_None; char * const qsub = (char*)malloc((strlen(pkg) + strlen(sub) + 1)*sizeof(char)); sprintf(qsub,"%s%s",pkg,sub); if (perl_get_cv(qsub,0)) { retval = Py_True; } free(qsub); Py_INCREF(retval); return retval; } int py_is_tuple(SV *arr) { if (SvROK(arr) && SvTYPE(SvRV(arr)) == SVt_PVAV) { MAGIC * const mg = mg_find(SvRV(arr), PERL_MAGIC_ext); return (mg && Inline_Magic_Key(mg->mg_ptr) == TUPLE_MAGIC_KEY); } else return 0; }