#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "Python.h"
#include "py2pl.h"
#include "util.h"
#ifdef EXPOSE_PERL
#include "perlmodule.h"
#endif
/****************************
* SV* Py2Pl(PyObject *obj)
*
* Converts arbitrary Python data structures to Perl data structures
* Note on references: does not Py_DECREF(obj).
*
* Modifications by Eric Wilhelm 2004-07-11 marked as elw
*
****************************/
SV *Py2Pl(PyObject * obj) {
/* elw: see what python says things are */
int is_string = PyString_Check(obj) || PyUnicode_Check(obj);
#ifdef I_PY_DEBUG
PyObject *this_type = PyObject_Type(obj);
PyObject *t_string = PyObject_Str(this_type);
char *type_str = PyString_AsString(t_string);
Py_DECREF(t_string);
Printf(("type is %s\n", type_str));
printf("Py2Pl object:\n\t");
PyObject_Print(obj, stdout, Py_PRINT_RAW);
printf("\ntype:\n\t");
PyObject_Print(this_type, stdout, Py_PRINT_RAW);
printf("\n");
Printf(("String check: %i\n", is_string));
Printf(("Number check: %i\n", PyNumber_Check(obj)));
Printf(("Int check: %i\n", PyInt_Check(obj)));
Printf(("Long check: %i\n", PyLong_Check(obj)));
Printf(("Float check: %i\n", PyFloat_Check(obj)));
Printf(("Type check: %i\n", PyType_Check(obj)));
Printf(("Instance check: %i\n", PyInstance_Check(obj)));
Printf(("Dict check: %i\n", PyDict_Check(obj)));
Printf(("Mapping check: %i\n", PyMapping_Check(obj)));
Printf(("Sequence check: %i\n", PySequence_Check(obj)));
Printf(("Iter check: %i\n", PyIter_Check(obj)));
Printf(("Function check: %i\n", PyFunction_Check(obj)));
Printf(("Module check: %i\n", PyModule_Check(obj)));
Printf(("Class check: %i\n", PyClass_Check(obj)));
Printf(("Method check: %i\n", PyMethod_Check(obj)));
if ((obj->ob_type->tp_flags & Py_TPFLAGS_HEAPTYPE))
printf("heaptype true\n");
if ((obj->ob_type->tp_flags & Py_TPFLAGS_HAVE_CLASS))
printf("has class\n");
Py_DECREF(this_type);
#endif
/* elw: this needs to be early */
/* None (like undef) */
if (!obj || obj == Py_None) {
Printf(("Py2Pl: Py_None\n"));
return &PL_sv_undef;
}
else
#ifdef EXPOSE_PERL
/* unwrap Perl objects */
if (PerlObjObject_Check(obj)) {
Printf(("Py2Pl: Obj_object\n"));
return ((PerlObj_object *) obj)->obj;
}
/* unwrap Perl code refs */
else if (PerlSubObject_Check(obj)) {
Printf(("Py2Pl: Sub_object\n"));
SV *ref = ((PerlSub_object *) obj)->ref;
if (! ref) { /* probably an inherited method */
if (! ((PerlSub_object *) obj)->obj)
croak("Error: could not find a code reference or object method for PerlSub");
SV *sub_obj = (SV*)SvRV(((PerlSub_object *) obj)->obj);
HV* pkg = SvSTASH(sub_obj);
char *sub = PyString_AsString(PyObject_Str(((PerlSub_object *) obj)->sub));
GV* const gv = Perl_gv_fetchmethod_autoload(aTHX_ pkg, sub, TRUE);
if (gv && isGV(gv)) {
ref = (SV *)GvCV(gv);
}
}
return newRV_inc((SV *) ref);
}
else
#endif
/* wrap an instance of a Python class */
/* elw: here we need to make these look like instances: */
if ((obj->ob_type->tp_flags & Py_TPFLAGS_HEAPTYPE) || PyInstance_Check(obj)) {
/* This is a Python class instance -- bless it into an
* Inline::Python::Object. If we're being called from an
* Inline::Python class, it will be re-blessed into whatever
* class that is.
*/
SV *inst_ptr = newSViv(0);
SV *inst;
MAGIC *mg;
_inline_magic priv;
inst = newSVrv(inst_ptr, "Inline::Python::Object");
/* set up magic */
priv.key = INLINE_MAGIC_KEY;
sv_magic(inst, inst, PERL_MAGIC_ext, (char *) &priv, sizeof(priv));
mg = mg_find(inst, PERL_MAGIC_ext);
mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL));
mg->mg_virtual->svt_free = free_inline_py_obj;
sv_setiv(inst, (IV) obj);
/*SvREADONLY_on(inst); */ /* to uncomment this means I can't
re-bless it */
Py_INCREF(obj);
Printf(("Py2Pl: Instance. Obj: %p, inst_ptr: %p\n", obj, inst_ptr));
sv_2mortal(inst_ptr);
return inst_ptr;
}
/* a tuple or a list */
else if (PySequence_Check(obj) && !is_string) {
AV *retval = newAV();
int i;
int sz = PySequence_Length(obj);
Printf(("sequence (%i)\n", sz));
for (i = 0; i < sz; i++) {
PyObject *tmp = PySequence_GetItem(obj, i); /* new reference */
SV *next = Py2Pl(tmp);
av_push(retval, next);
if (sv_isobject(next)) // needed because objects get mortalized in Py2Pl
SvREFCNT_inc(next);
Py_DECREF(tmp);
}
if (PyTuple_Check(obj)) {
_inline_magic priv;
priv.key = TUPLE_MAGIC_KEY;
sv_magic((SV * const)retval, (SV * const)NULL, PERL_MAGIC_ext, (char *) &priv, sizeof(priv));
}
return newRV_noinc((SV *) retval);
}
/* a dictionary or fake Mapping object */
/* elw: PyMapping_Check() now returns true for strings */
else if (! is_string && PyMapping_Check(obj)) {
HV *retval = newHV();
int i;
int sz = PyMapping_Length(obj);
PyObject *keys = PyMapping_Keys(obj); /* new reference */
PyObject *vals = PyMapping_Values(obj); /* new reference */
Printf(("Py2Pl: dict/map\n"));
Printf(("mapping (%i)\n", sz));
for (i = 0; i < sz; i++) {
PyObject *key, *val;
SV *sv_val;
char *key_val;
Printf(("working on map item %i\n", i));
key = PySequence_GetItem(keys, i); /* new reference */
val = PySequence_GetItem(vals, i); /* new reference */
#ifdef I_PY_DEBUG
printf("recursive call to get value for key:");
PyObject_Print(key, stdout, Py_PRINT_RAW);
printf("\n");
#endif
sv_val = Py2Pl(val);
if (PyUnicode_Check(key)) {
PyObject *utf8_string = PyUnicode_AsUTF8String(key);
key_val = PyString_AsString(utf8_string);
SV *utf8_key = newSVpv(key_val, PyString_Size(utf8_string));
SvUTF8_on(utf8_key);
hv_store_ent(retval, utf8_key, sv_val, 0);
}
else {
if (PyString_Check(key)) {
key_val = PyString_AsString(key);
}
else {
/* Warning -- encountered a non-string key value while converting a
* Python dictionary into a Perl hash. Perl can only use strings as
* key values. Using Python's string representation of the key as
* Perl's key value.
*/
PyObject *s = PyObject_Str(key);
key_val = PyString_AsString(s);
Py_DECREF(s);
if (PL_dowarn)
warn("Stringifying non-string hash key value: '%s'",
key_val);
}
if (!key_val) {
croak("Invalid key on key %i of mapping\n", i);
}
hv_store(retval, key_val, strlen(key_val), sv_val, 0);
}
if (sv_isobject(sv_val)) // needed because objects get mortalized in Py2Pl
SvREFCNT_inc(sv_val);
Py_DECREF(key);
Py_DECREF(val);
}
Py_DECREF(keys);
Py_DECREF(vals);
return newRV_noinc((SV *) retval);
}
/* an int */
else if (PyInt_Check(obj)) {
SV *sv = newSViv(PyInt_AsLong(obj));
Printf(("Py2Pl: integer\n"));
return sv;
}
/* a function or method */
else if (PyFunction_Check(obj) || PyMethod_Check(obj)) {
SV *inst_ptr = newSViv(0);
SV *inst;
MAGIC *mg;
_inline_magic priv;
inst = newSVrv(inst_ptr, "Inline::Python::Function");
/* set up magic */
priv.key = INLINE_MAGIC_KEY;
sv_magic(inst, inst, '~', (char *) &priv, sizeof(priv));
mg = mg_find(inst, '~');
mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL));
mg->mg_virtual->svt_free = free_inline_py_obj;
sv_setiv(inst, (IV) obj);
/*SvREADONLY_on(inst); */ /* to uncomment this means I can't
re-bless it */
Py_INCREF(obj);
Printf(("Py2Pl: Instance. Obj: %p, inst_ptr: %p\n", obj, inst_ptr));
sv_2mortal(inst_ptr);
return inst_ptr;
}
else if (PyUnicode_Check(obj)) {
PyObject *string = PyUnicode_AsUTF8String(obj); /* new reference */
if (!string) {
Printf(("Py2Pl: string is NULL!? -> Py_None\n"));
return &PL_sv_undef;
}
char *str = PyString_AsString(string);
SV *s2 = newSVpv(str, PyString_Size(string));
SvUTF8_on(s2);
Printf(("Py2Pl: utf8 string \n"));
Py_DECREF(string);
return s2;
}
/* a string (or number) */
else {
PyObject *string = PyObject_Str(obj); /* new reference */
if (!string) {
Printf(("Py2Pl: string is NULL!? -> Py_None\n"));
return &PL_sv_undef;
}
char *str = PyString_AsString(string);
SV *s2 = newSVpv(str, PyString_Size(string));
Printf(("Py2Pl: string / number\n"));
Py_DECREF(string);
return s2;
}
}
/****************************
* SV* Pl2Py(PyObject *obj)
*
* Converts arbitrary Perl data structures to Python data structures
****************************/
PyObject *Pl2Py(SV * obj) {
PyObject *o;
/* an object */
if (sv_isobject(obj)) {
/* We know it's a blessed reference:
* Now it's time to check whether it's *really* a blessed Perl object,
* or whether it's a blessed Python object with '~' magic set.
* If '~' magic is set, we 'unwrap' it into its Python object.
* If not, we wrap it up in a PerlObj_object. */
SV *obj_deref = SvRV(obj);
/* check for magic! */
MAGIC *mg = mg_find(obj_deref, '~');
if (mg && Inline_Magic_Check(mg->mg_ptr)) {
IV ptr = SvIV(obj_deref);
if (!ptr) {
croak
("Internal error: Pl2Py() caught NULL PyObject* at %s, line %i.\n",
__FILE__, __LINE__);
}
o = (PyObject *) ptr;
Py_INCREF(o);
}
else {
HV *stash = SvSTASH(obj_deref);
char *pkg = HvNAME(stash);
SV *full_pkg = newSVpvf("main::%s::", pkg);
PyObject *pkg_py;
Printf(("A Perl object (%s, refcnt: %i). Wrapping...\n",
SvPV(full_pkg, PL_na), SvREFCNT(obj)));
pkg_py = PyString_FromString(SvPV(full_pkg, PL_na));
o = newPerlObj_object(obj, pkg_py);
Py_DECREF(pkg_py);
SvREFCNT_dec(full_pkg);
}
}
/* An integer */
else if (SvIOK(obj)) {
Printf(("integer\n"));
o = PyInt_FromLong((long) SvIV(obj));
}
/* A floating-point number */
else if (SvNOK(obj)) {
PyObject *tmp = PyString_FromString(SvPV_nolen(obj));
Printf(("float\n"));
if (tmp)
o = PyNumber_Float(tmp);
else {
fprintf(stderr, "Internal Error --");
fprintf(stderr, "your Perl string \"%s\" could not \n",
SvPV_nolen(obj));
fprintf(stderr, "be converted to a Python string\n");
o = PyFloat_FromDouble((double) 0);
}
Py_DECREF(tmp);
}
/* A string */
else if (SvPOKp(obj)) {
STRLEN len;
char *str = SvPV(obj, len);
Printf(("string = "));
Printf(("%s\n", str));
if (SvUTF8(obj))
o = PyUnicode_DecodeUTF8(str, len, "replace");
else
o = PyString_FromStringAndSize(str, len);
Printf(("string ok\n"));
}
/* An array */
else if (SvROK(obj) && SvTYPE(SvRV(obj)) == SVt_PVAV) {
AV *av = (AV *) SvRV(obj);
int i;
int len = av_len(av) + 1;
if (py_is_tuple(obj)) {
o = PyTuple_New(len);
Printf(("tuple (%i)\n", len));
for (i = 0; i < len; i++) {
SV **tmp = av_fetch(av, i, 0);
if (tmp) {
PyObject *tmp_py = Pl2Py(*tmp);
PyTuple_SetItem(o, i, tmp_py);
}
else {
Printf(("Got a NULL from av_fetch for element %i. Might be a bug!", i));
Py_INCREF(Py_None);
PyTuple_SetItem(o, i, Py_None);
}
}
}
else {
o = PyList_New(len);
Printf(("array (%i)\n", len));
for (i = 0; i < len; i++) {
SV **tmp = av_fetch(av, i, 0);
if (tmp) {
PyObject *tmp_py = Pl2Py(*tmp);
PyList_SetItem(o, i, tmp_py);
}
else {
Printf(("Got a NULL from av_fetch for element %i. Might be a bug!", i));
Py_INCREF(Py_None);
PyList_SetItem(o, i, Py_None);
}
}
}
}
/* A hash */
else if (SvROK(obj) && SvTYPE(SvRV(obj)) == SVt_PVHV) {
HV *hv = (HV *) SvRV(obj);
int len = hv_iterinit(hv);
int i;
o = PyDict_New();
Printf(("hash (%i)\n", len));
for (i = 0; i < len; i++) {
HE *next = hv_iternext(hv);
SV *key = hv_iterkeysv(next);
if (!key)
croak("Hash entry without key!?");
STRLEN len;
char *key_str = SvPV(key, len);
PyObject *py_key;
if (SvUTF8(key))
py_key = PyUnicode_DecodeUTF8(key_str, len, "replace");
else
py_key = PyString_FromStringAndSize(key_str, len);
PyObject *val = Pl2Py(hv_iterval(hv, next));
PyDict_SetItem(o, py_key, val);
Py_DECREF(py_key);
Py_DECREF(val);
}
Printf(("returning from hash conversion.\n"));
}
/* A code ref */
else if (SvROK(obj) && SvTYPE(SvRV(obj)) == SVt_PVCV) {
/* wrap this into a PerlSub_object */
o = (PyObject *) newPerlSub_object(NULL, NULL, obj);
}
else {
Printf(("undef -> None\n"));
o = Py_None;
Py_INCREF(Py_None);
}
Printf(("returning from Pl2Py\n"));
return o;
}
void
croak_python_exception() {
PyObject *ex_type, *ex_value, *ex_traceback;
PyErr_Fetch(&ex_type, &ex_value, &ex_traceback);
PyErr_NormalizeException(&ex_type, &ex_value, &ex_traceback);
PyObject *ex_message = PyObject_Str(ex_value); /* new reference */
if (ex_traceback) {
PyObject *tb_lineno = PyObject_GetAttrString(ex_traceback, "tb_lineno");
croak("%s: %s at line %i\n", ((PyTypeObject *)ex_type)->tp_name, PyString_AsString(ex_message), PyInt_AsLong(tb_lineno));
Py_DECREF(tb_lineno);
}
else {
croak("%s: %s", ((PyTypeObject *)ex_type)->tp_name, PyString_AsString(ex_message));
}
Py_DECREF(ex_message);
Py_DECREF(ex_type);
Py_DECREF(ex_value);
Py_XDECREF(ex_traceback);
}