The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

NINE / Inline-Python-0.57 / util.c 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124

              
/* 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;
}