1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #include "Python.h"
6 #include "py2pl.h"
7 #include "util.h"
8
9 #ifdef EXPOSE_PERL
10 #include "perlmodule.h"
11 #endif
12
13 SV* py_true;
14 SV* py_false;
15
16 /****************************
17 * SV* Py2Pl(PyObject *obj)
18 *
19 * Converts arbitrary Python data structures to Perl data structures
20 * Note on references: does not Py_DECREF(obj).
21 *
22 * Modifications by Eric Wilhelm 2004-07-11 marked as elw
23 *
24 ****************************/
Py2Pl(PyObject * const obj)25 SV *Py2Pl(PyObject * const obj) {
26 /* elw: see what python says things are */
27 #if PY_MAJOR_VERSION >= 3
28 int const is_string = PyBytes_Check(obj) || PyUnicode_Check(obj);
29 #else
30 int const is_string = PyString_Check(obj) || PyUnicode_Check(obj);
31 #endif
32 #ifdef I_PY_DEBUG
33 PyObject *this_type = PyObject_Type(obj); /* new reference */
34 PyObject *t_string = PyObject_Str(this_type); /* new reference */
35 #if PY_MAJOR_VERSION >= 3
36 PyObject *type_str_bytes = PyUnicode_AsUTF8String(t_string); /* new reference */
37 char *type_str = PyBytes_AsString(type_str_bytes);
38 #else
39 char *type_str = PyString_AsString(t_string);
40 #endif
41 Printf(("type is %s\n", type_str));
42 printf("Py2Pl object:\n\t");
43 PyObject_Print(obj, stdout, Py_PRINT_RAW);
44 printf("\ntype:\n\t");
45 PyObject_Print(this_type, stdout, Py_PRINT_RAW);
46 printf("\n");
47 Printf(("String check: %i\n", is_string));
48 Printf(("Number check: %i\n", PyNumber_Check(obj)));
49 Printf(("Int check: %i\n", PyInt_Check(obj)));
50 Printf(("Long check: %i\n", PyLong_Check(obj)));
51 Printf(("Float check: %i\n", PyFloat_Check(obj)));
52 Printf(("Type check: %i\n", PyType_Check(obj)));
53 #if PY_MAJOR_VERSION < 3
54 Printf(("Class check: %i\n", PyClass_Check(obj)));
55 Printf(("Instance check: %i\n", PyInstance_Check(obj)));
56 #endif
57 Printf(("Dict check: %i\n", PyDict_Check(obj)));
58 Printf(("Mapping check: %i\n", PyMapping_Check(obj)));
59 Printf(("Sequence check: %i\n", PySequence_Check(obj)));
60 Printf(("Iter check: %i\n", PyIter_Check(obj)));
61 Printf(("Function check: %i\n", PyFunction_Check(obj)));
62 Printf(("Module check: %i\n", PyModule_Check(obj)));
63 Printf(("Method check: %i\n", PyMethod_Check(obj)));
64 #if PY_MAJOR_VERSION < 3
65 if ((obj->ob_type->tp_flags & Py_TPFLAGS_HEAPTYPE))
66 printf("heaptype true\n");
67 if ((obj->ob_type->tp_flags & Py_TPFLAGS_HAVE_CLASS))
68 printf("has class\n");
69 #else
70 Py_DECREF(type_str_bytes);
71 #endif
72 Py_DECREF(t_string);
73 Py_DECREF(this_type);
74 #endif
75 /* elw: this needs to be early */
76 /* None (like undef) */
77 if (!obj || obj == Py_None) {
78 Printf(("Py2Pl: Py_None\n"));
79 return &PL_sv_undef;
80 }
81 else
82
83 #ifdef EXPOSE_PERL
84 /* unwrap Perl objects */
85 if (PerlObjObject_Check(obj)) {
86 Printf(("Py2Pl: Obj_object\n"));
87 return ((PerlObj_object *) obj)->obj;
88 }
89
90 /* unwrap Perl code refs */
91 else if (PerlSubObject_Check(obj)) {
92 Printf(("Py2Pl: Sub_object\n"));
93 SV * ref = ((PerlSub_object *) obj)->ref;
94 if (! ref) { /* probably an inherited method */
95 if (! ((PerlSub_object *) obj)->obj)
96 croak("Error: could not find a code reference or object method for PerlSub");
97 SV * const sub_obj = (SV*)SvRV(((PerlSub_object *) obj)->obj);
98 HV * const pkg = SvSTASH(sub_obj);
99 #if PY_MAJOR_VERSION >= 3
100 char * const sub = PyBytes_AsString(((PerlSub_object *) obj)->sub);
101 #else
102 PyObject *obj_sub_str = PyObject_Str(((PerlSub_object *) obj)->sub); /* new ref. */
103 char * const sub = PyString_AsString(obj_sub_str);
104 #endif
105 GV * const gv = Perl_gv_fetchmethod_autoload(aTHX_ pkg, sub, TRUE);
106 if (gv && isGV(gv)) {
107 ref = (SV *)GvCV(gv);
108 }
109 #if PY_MAJOR_VERSION < 3
110 Py_DECREF(obj_sub_str);
111 #endif
112 }
113 return newRV_inc((SV *) ref);
114 }
115
116 else
117 #endif
118
119 /* wrap an instance of a Python class */
120 /* elw: here we need to make these look like instances: */
121 if ((obj->ob_type->tp_flags & Py_TPFLAGS_HEAPTYPE)
122 #if PY_MAJOR_VERSION < 3
123 || PyInstance_Check(obj)
124 #endif
125 ) {
126
127 /* This is a Python class instance -- bless it into an
128 * Inline::Python::Object. If we're being called from an
129 * Inline::Python class, it will be re-blessed into whatever
130 * class that is.
131 */
132 SV * const inst_ptr = newSViv(0);
133 SV * const inst = newSVrv(inst_ptr, "Inline::Python::Object");;
134 _inline_magic priv;
135
136 /* set up magic */
137 priv.key = INLINE_MAGIC_KEY;
138 sv_magic(inst, inst, PERL_MAGIC_ext, (char *) &priv, sizeof(priv));
139 MAGIC * const mg = mg_find(inst, PERL_MAGIC_ext);
140 mg->mg_virtual = &inline_mg_vtbl;
141
142 sv_setiv(inst, (IV) obj);
143 /*SvREADONLY_on(inst); */ /* to uncomment this means I can't
144 re-bless it */
145 Py_INCREF(obj);
146 Printf(("Py2Pl: Instance. Obj: %p, inst_ptr: %p\n", obj, inst_ptr));
147
148 sv_2mortal(inst_ptr);
149 return inst_ptr;
150 }
151
152 /* a tuple or a list */
153 else if (PySequence_Check(obj) && !is_string) {
154 AV * const retval = newAV();
155 int i;
156 int const sz = PySequence_Length(obj);
157
158 Printf(("sequence (%i)\n", sz));
159
160 for (i = 0; i < sz; i++) {
161 PyObject * const tmp = PySequence_GetItem(obj, i); /* new reference */
162 SV * const next = Py2Pl(tmp);
163 av_push(retval, next);
164 if (sv_isobject(next)) // needed because objects get mortalized in Py2Pl
165 SvREFCNT_inc(next);
166 Py_DECREF(tmp);
167 }
168
169 if (PyTuple_Check(obj)) {
170 _inline_magic priv;
171 priv.key = TUPLE_MAGIC_KEY;
172
173 sv_magic((SV * const)retval, (SV * const)NULL, PERL_MAGIC_ext, (char *) &priv, sizeof(priv));
174 }
175
176 return newRV_noinc((SV *) retval);
177 }
178
179 /* a dictionary or fake Mapping object */
180 /* elw: PyMapping_Check() now returns true for strings */
181 else if (! is_string && PyMapping_Check(obj)) {
182 HV * const retval = newHV();
183 int i;
184 int const sz = PyMapping_Length(obj);
185 PyObject * const keys = PyMapping_Keys(obj); /* new reference */
186 PyObject * const vals = PyMapping_Values(obj); /* new reference */
187
188 Printf(("Py2Pl: dict/map\n"));
189 Printf(("mapping (%i)\n", sz));
190
191 for (i = 0; i < sz; i++) {
192 PyObject * const key = PySequence_GetItem(keys, i), /* new reference */
193 * const val = PySequence_GetItem(vals, i); /* new reference */
194 SV * const sv_val = Py2Pl(val);
195 char * key_val;
196
197 if (PyUnicode_Check(key)) {
198 PyObject * const utf8_string = PyUnicode_AsUTF8String(key); /* new reference */
199 #if PY_MAJOR_VERSION >= 3
200 key_val = PyBytes_AsString(utf8_string);
201 SV * const utf8_key = newSVpv(key_val, PyBytes_Size(utf8_string));
202 #else
203 key_val = PyString_AsString(utf8_string);
204 SV * const utf8_key = newSVpv(key_val, PyString_Size(utf8_string));
205 #endif
206 SvUTF8_on(utf8_key);
207
208 hv_store_ent(retval, utf8_key, sv_val, 0);
209
210 sv_2mortal(utf8_key);
211 Py_DECREF(utf8_string);
212 }
213 else {
214 PyObject * s = NULL;
215 #if PY_MAJOR_VERSION >= 3
216 PyObject * s_bytes = NULL;
217 if (PyBytes_Check(key)) {
218 key_val = PyBytes_AsString(key);
219 #else
220 if (PyString_Check(key)) {
221 key_val = PyString_AsString(key);
222 #endif
223 }
224 else {
225 /* Warning -- encountered a non-string key value while converting a
226 * Python dictionary into a Perl hash. Perl can only use strings as
227 * key values. Using Python's string representation of the key as
228 * Perl's key value.
229 */
230 s = PyObject_Str(key); /* new reference */
231 #if PY_MAJOR_VERSION >= 3
232 s_bytes = PyUnicode_AsUTF8String(s); /* new reference */
233 key_val = PyBytes_AsString(s_bytes);
234 #else
235 key_val = PyString_AsString(s);
236 #endif
237 if (PL_dowarn)
238 warn("Stringifying non-string hash key value: '%s'",
239 key_val);
240 }
241
242 if (!key_val) {
243 croak("Invalid key on key %i of mapping\n", i);
244 }
245
246 hv_store(retval, key_val, strlen(key_val), sv_val, 0);
247 #if PY_MAJOR_VERSION >= 3
248 Py_XDECREF(s_bytes);
249 #endif
250 Py_XDECREF(s);
251 }
252 if (sv_isobject(sv_val)) // needed because objects get mortalized in Py2Pl
253 SvREFCNT_inc(sv_val);
254 Py_DECREF(key);
255 Py_DECREF(val);
256 }
257 Py_DECREF(keys);
258 Py_DECREF(vals);
259 return newRV_noinc((SV *) retval);
260 }
261
262 /* a boolean */
263 else if (PyBool_Check(obj)) {
264 Printf(("Py2Pl: boolean\n"));
265 if (obj == Py_True)
266 return py_true;
267 if (obj == Py_False)
268 return py_false;
269
270 croak(
271 "Internal error: Pl2Py() caught a bool that is not True or False!? at %s, line %i.\n",
272 __FILE__,
273 __LINE__
274 );
275 }
276
277 /* an int */
278 else if (PyInt_Check(obj)) {
279 SV * const sv = newSViv(PyInt_AsLong(obj));
280 Printf(("Py2Pl: integer\n"));
281 return sv;
282 }
283
284 /* a float */
285 else if (PyFloat_Check(obj)) {
286 SV * const sv = newSVnv(PyFloat_AsDouble(obj));
287 Printf(("Py2Pl: float\n"));
288 return sv;
289 }
290
291 /* a function or method */
292 else if (PyFunction_Check(obj) || PyMethod_Check(obj)) {
293 SV * const inst_ptr = newSViv(0);
294 SV * const inst = newSVrv(inst_ptr, "Inline::Python::Function");
295 _inline_magic priv;
296
297 /* set up magic */
298 priv.key = INLINE_MAGIC_KEY;
299 sv_magic(inst, inst, '~', (char *) &priv, sizeof(priv));
300 MAGIC * const mg = mg_find(inst, '~');
301 mg->mg_virtual = &inline_mg_vtbl;
302
303 sv_setiv(inst, (IV) obj);
304 /*SvREADONLY_on(inst); */ /* to uncomment this means I can't
305 re-bless it */
306 Py_INCREF(obj);
307 Printf(("Py2Pl: Instance. Obj: %p, inst_ptr: %p\n", obj, inst_ptr));
308
309 sv_2mortal(inst_ptr);
310 return inst_ptr;
311 }
312
313 #if PY_MAJOR_VERSION >= 3
314 /* In P3, I stringify Bytes explicitly to avoid "b'fdsfd'" as Perl string.
315 * "PyObject_Str" is fine for string object. */
316 else if (PyBytes_Check(obj)) {
317 char * const str = PyBytes_AsString(obj);
318 SV * const s2 = newSVpv(str, PyBytes_Size(obj));
319 Printf(("Py2Pl: bytes \n"));
320 return s2;
321 }
322 #endif
323 else if (PyUnicode_Check(obj)) {
324 PyObject * const string = PyUnicode_AsUTF8String(obj); /* new reference */
325 if (!string) {
326 Printf(("Py2Pl: string is NULL!? -> Py_None\n"));
327 return &PL_sv_undef;
328 }
329 #if PY_MAJOR_VERSION >= 3
330 char * const str = PyBytes_AsString(string);
331 SV * const s2 = newSVpv(str, PyBytes_Size(string));
332 #else
333 char * const str = PyString_AsString(string);
334 SV * const s2 = newSVpv(str, PyString_Size(string));
335 #endif
336 SvUTF8_on(s2);
337 Printf(("Py2Pl: utf8 string \n"));
338 Py_DECREF(string);
339 return s2;
340 }
341
342 /* P2: a string (or number). P3: number*/
343 else {
344 PyObject * const string = PyObject_Str(obj); /* new reference */
345 if (!string) {
346 Printf(("Py2Pl: string is NULL!? -> Py_None\n"));
347 return &PL_sv_undef;
348 }
349 #if PY_MAJOR_VERSION >= 3
350 PyObject * const string_as_bytes = PyUnicode_AsUTF8String(string); /* new reference */
351 char * const str = PyBytes_AsString(string_as_bytes);
352 SV * const s2 = newSVpv(str, PyBytes_Size(string_as_bytes));
353 Py_DECREF(string_as_bytes);
354 #else
355 char * const str = PyString_AsString(string);
356 SV * const s2 = newSVpv(str, PyString_Size(string));
357 #endif
358 Printf(("Py2Pl: string / number\n"));
359 Py_DECREF(string);
360 return s2;
361 }
362 }
363
364 /****************************
365 * SV* Pl2Py(PyObject *obj)
366 *
367 * Converts arbitrary Perl data structures to Python data structures
368 ****************************/
369 PyObject *Pl2Py(SV * const obj) {
370 PyObject *o;
371
372 /* an object */
373 if (sv_isobject(obj)) {
374 /* We know it's a blessed reference: */
375
376 SV * const obj_deref = SvRV(obj);
377
378 /* First check if it's one of the Inline::Python::Boolean values */
379
380 if (obj == py_true || obj_deref == SvRV(py_true))
381 Py_RETURN_TRUE;
382 if (obj == py_false || obj_deref == SvRV(py_false))
383 Py_RETURN_FALSE;
384
385 /*
386 * Now it's time to check whether it's *really* a blessed Perl object,
387 * or whether it's a blessed Python object with '~' magic set.
388 * If '~' magic is set, we 'unwrap' it into its Python object.
389 * If not, we wrap it up in a PerlObj_object. */
390
391 /* check for magic! */
392 MAGIC * const mg = mg_find(obj_deref, '~');
393
394 if (mg && Inline_Magic_Check(mg->mg_ptr)) {
395 IV const ptr = SvIV(obj_deref);
396 if (!ptr) {
397 croak
398 ("Internal error: Pl2Py() caught NULL PyObject* at %s, line %i.\n",
399 __FILE__, __LINE__);
400 }
401 o = (PyObject *) ptr;
402 Py_INCREF(o);
403 }
404 else {
405 HV * const stash = SvSTASH(obj_deref);
406 char * const pkg = HvNAME(stash);
407 SV * const full_pkg = newSVpvf("main::%s::", pkg);
408
409 Printf(("A Perl object (%s, refcnt: %i). Wrapping...\n",
410 SvPV(full_pkg, PL_na), SvREFCNT(obj)));
411
412 #if PY_MAJOR_VERSION >= 3
413 PyObject * const pkg_py = PyBytes_FromString(SvPV(full_pkg, PL_na));
414 #else
415 PyObject * const pkg_py = PyString_FromString(SvPV(full_pkg, PL_na));
416 #endif
417 o = newPerlObj_object(obj, pkg_py);
418
419 Py_DECREF(pkg_py);
420 SvREFCNT_dec(full_pkg);
421 }
422 }
423
424 /* An integer */
425 else if (SvIOK(obj)) {
426 Printf(("integer\n"));
427 o = PyInt_FromLong((long) SvIV(obj));
428 }
429 /* A floating-point number */
430 else if (SvNOK(obj)) {
431 o = PyFloat_FromDouble(SvNV(obj));
432 }
433 /* A string */
434 else if (SvPOKp(obj)) {
435 STRLEN len;
436 char * const str = SvPV(obj, len);
437 Printf(("string = "));
438 Printf(("%s\n", str));
439 #if PY_MAJOR_VERSION >= 3
440 if (SvUTF8(obj))
441 o = PyUnicode_DecodeUTF8(str, len, "replace");
442 else
443 o = PyBytes_FromStringAndSize(str, len);
444 #else
445 if (SvUTF8(obj))
446 o = PyUnicode_DecodeUTF8(str, len, "replace");
447 else
448 o = PyString_FromStringAndSize(str, len);
449 #endif
450 Printf(("string ok\n"));
451 }
452 /* An array */
453 else if (SvROK(obj) && SvTYPE(SvRV(obj)) == SVt_PVAV) {
454 AV * const av = (AV *) SvRV(obj);
455 int const len = av_len(av) + 1;
456 int i;
457
458 if (py_is_tuple(obj)) {
459 o = PyTuple_New(len);
460
461 Printf(("tuple (%i)\n", len));
462
463 for (i = 0; i < len; i++) {
464 SV ** const tmp = av_fetch(av, i, 0);
465 if (tmp) {
466 PyObject * const tmp_py = Pl2Py(*tmp);
467 PyTuple_SetItem(o, i, tmp_py);
468 }
469 else {
470 Printf(("Got a NULL from av_fetch for element %i. Might be a bug!", i));
471 Py_INCREF(Py_None);
472 PyTuple_SetItem(o, i, Py_None);
473 }
474 }
475 }
476 else {
477 o = PyList_New(len);
478
479 Printf(("array (%i)\n", len));
480
481 for (i = 0; i < len; i++) {
482 SV ** const tmp = av_fetch(av, i, 0);
483 if (tmp) {
484 PyObject * const tmp_py = Pl2Py(*tmp);
485 PyList_SetItem(o, i, tmp_py);
486 }
487 else {
488 Printf(("Got a NULL from av_fetch for element %i. Might be a bug!", i));
489 Py_INCREF(Py_None);
490 PyList_SetItem(o, i, Py_None);
491 }
492 }
493 }
494 }
495 /* A hash */
496 else if (SvROK(obj) && SvTYPE(SvRV(obj)) == SVt_PVHV) {
497 HV * const hv = (HV *) SvRV(obj);
498 int const len = hv_iterinit(hv);
499 int i;
500
501 o = PyDict_New();
502
503 Printf(("hash (%i)\n", len));
504
505 for (i = 0; i < len; i++) {
506 HE * const next = hv_iternext(hv);
507 SV * const key = hv_iterkeysv(next);
508 if (!key)
509 croak("Hash entry without key!?");
510 STRLEN len;
511 char * const key_str = SvPV(key, len);
512 PyObject *py_key;
513 #if PY_MAJOR_VERSION >= 3
514 if (SvUTF8(key))
515 py_key = PyUnicode_DecodeUTF8(key_str, len, "replace");
516 else
517 py_key = PyBytes_FromStringAndSize(key_str, len);
518 #else
519 if (SvUTF8(key))
520 py_key = PyUnicode_DecodeUTF8(key_str, len, "replace");
521 else
522 py_key = PyString_FromStringAndSize(key_str, len);
523 #endif
524 PyObject * const val = Pl2Py(hv_iterval(hv, next));
525 PyDict_SetItem(o, py_key, val);
526 Py_DECREF(py_key);
527 Py_DECREF(val);
528 }
529
530 Printf(("returning from hash conversion.\n"));
531
532 }
533 /* A code ref */
534 else if (SvROK(obj) && SvTYPE(SvRV(obj)) == SVt_PVCV) {
535 /* wrap this into a PerlSub_object */
536
537 o = (PyObject *) newPerlSub_object(NULL, NULL, obj);
538 }
539
540 else {
541 Printf(("undef -> None\n"));
542 o = Py_None;
543 Py_INCREF(Py_None);
544 }
545 Printf(("returning from Pl2Py\n"));
546 return o;
547 }
548
549 void
550 croak_python_exception() {
551 PyObject *ex_type, *ex_value, *ex_traceback;
552 if (PyErr_ExceptionMatches(PyExc_Perl)) {
553 PyErr_Fetch(&ex_type, &ex_value, &ex_traceback);
554 PyErr_NormalizeException(&ex_type, &ex_value, &ex_traceback);
555 PyObject *perl_exception_args = PyObject_GetAttrString(ex_value, "args");
556 PyObject *perl_exception = PySequence_GetItem(perl_exception_args, 0);
557 SV *perl_exception_object = Py2Pl(perl_exception);
558 sv_2mortal(perl_exception_object);
559 SV *errsv = get_sv("@", GV_ADD);
560 sv_setsv(errsv, perl_exception_object);
561 croak(NULL);
562 Py_DECREF(perl_exception);
563 Py_DECREF(perl_exception_args);
564 }
565 else {
566 PyErr_Fetch(&ex_type, &ex_value, &ex_traceback);
567 PyErr_NormalizeException(&ex_type, &ex_value, &ex_traceback);
568
569 PyObject * const ex_message = PyObject_Str(ex_value); /* new reference */
570
571 #if PY_MAJOR_VERSION >= 3
572 PyObject * const ex_message_bytes = PyUnicode_AsUTF8String(ex_message); /* new reference */
573 char * const c_ex_message = PyBytes_AsString(ex_message_bytes);
574 #else
575 char * const c_ex_message = PyString_AsString(ex_message);
576 #endif
577
578 if (ex_traceback) {
579 PyObject * const tb_lineno = PyObject_GetAttrString(ex_traceback, "tb_lineno");
580
581 croak("%s: %s at line %i\n", ((PyTypeObject *)ex_type)->tp_name, c_ex_message, PyInt_AsLong(tb_lineno));
582
583 Py_DECREF(tb_lineno);
584 }
585 else {
586 croak("%s: %s", ((PyTypeObject *)ex_type)->tp_name, c_ex_message);
587 }
588
589 #if PY_MAJOR_VERSION >= 3
590 Py_DECREF(ex_message_bytes);
591 #endif
592 Py_DECREF(ex_message);
593 }
594 Py_DECREF(ex_type);
595 Py_DECREF(ex_value);
596 Py_XDECREF(ex_traceback);
597 }
598
599 /*
600 * vim: expandtab shiftwidth=4 softtabstop=4 cinoptions='\:2=2' :
601 */
602