SV *p5_wrap_p6_callable(PerlInterpreter *my_perl, IV i, SV *p5obj, SV *(*call)(IV, SV *, SV **), void (*free_p6_object)(IV)) {
SV * inst;
SV * inst_ptr;
if (p5obj == NULL) {
inst_ptr = newSViv(0);
inst = newSVrv(inst_ptr, "Perl6::Callable");
}
else {
inst_ptr = p5obj;
inst = SvRV(inst_ptr);
SvREFCNT_inc(inst_ptr);
}
_perl6_magic priv;
/* set up magic */
priv.key = PERL6_MAGIC_KEY;
priv.index = i;
priv.call_p6_callable = call;
priv.free_p6_object = free_p6_object;
sv_magic(inst, inst, PERL_MAGIC_ext, (char *) &priv, sizeof(priv));
MAGIC * const mg = mg_find(inst, PERL_MAGIC_ext);
mg->mg_virtual = &p5_inline_mg_vtbl;
return inst_ptr;
}
SV*
newPerlPyObject_noinc(PyObject *pyo)
{
SV* rv;
SV* sv;
MAGIC *mg;
dCTXP;
ASSERT_LOCK_PERL;
if (!pyo)
croak("Missing pyo reference argument");
rv = newSV(0);
sv = newSVrv(rv, "Python::Object");
sv_setiv(sv, (IV)pyo);
sv_magic(sv, 0, '~', 0, 0);
mg = mg_find(sv, '~');
if (!mg) {
SvREFCNT_dec(rv);
croak("Can't assign magic to Python::Object");
}
mg->mg_virtual = &vtbl_free_pyo;
SvREADONLY(sv);
#ifdef REF_TRACE
printf("Bind pyo %p\n", pyo);
#endif
ASSERT_LOCK_PERL;
return rv;
}
SV *
PLCBA_construct(const char *pkg, AV *options)
{
PLCBA_t *async;
char *host, *username, *password, *bucket;
libcouchbase_t instance;
SV *blessed_obj;
Newxz(async, 1, PLCBA_t);
extract_async_options(async, options);
plcb_ctor_conversion_opts(&async->base, options);
plcb_ctor_cbc_opts(options, &host, &username, &password, &bucket);
instance = libcouchbase_create(host, username, password, bucket,
plcba_make_io_opts(async));
if(!instance) {
die("Couldn't create instance!");
}
plcb_ctor_init_common(&async->base, instance, options);
plcba_setup_callbacks(async);
async->base_rv = newRV_inc(newSViv(PTR2IV(&(async->base))));
blessed_obj = newSV(0);
sv_setiv(newSVrv(blessed_obj, pkg), PTR2IV(async));
return blessed_obj;
}
/*
* Create a new ::Object by wrapping an ea_object_t in a perl SV. This is used
* to wrap exacct records that have been read from a file, or packed records
* that have been inflated.
*/
SV *
new_xs_ea_object(ea_object_t *ea_obj)
{
xs_ea_object_t *xs_obj;
SV *sv_obj;
/* Allocate space - use perl allocator. */
New(0, xs_obj, 1, xs_ea_object_t);
PERL_ASSERT(xs_obj != NULL);
xs_obj->ea_obj = ea_obj;
xs_obj->perl_obj = NULL;
sv_obj = NEWSV(0, 0);
PERL_ASSERT(sv_obj != NULL);
/*
* Initialise according to the type of the passed exacct object,
* and bless the perl object into the appropriate class.
*/
if (ea_obj->eo_type == EO_ITEM) {
if ((ea_obj->eo_catalog & EXT_TYPE_MASK) == EXT_EXACCT_OBJECT) {
INIT_EMBED_ITEM_FLAGS(xs_obj);
} else {
INIT_PLAIN_ITEM_FLAGS(xs_obj);
}
sv_setiv(newSVrv(sv_obj, NULL), PTR2IV(xs_obj));
sv_bless(sv_obj, Sun_Solaris_Exacct_Object_Item_stash);
} else {
INIT_GROUP_FLAGS(xs_obj);
sv_setiv(newSVrv(sv_obj, NULL), PTR2IV(xs_obj));
sv_bless(sv_obj, Sun_Solaris_Exacct_Object_Group_stash);
}
/*
* We are passing back a pointer masquerading as a perl IV,
* so make sure it can't be modified.
*/
SvREADONLY_on(SvRV(sv_obj));
return (sv_obj);
}
void set_up_debug_sv(const char* name) {
SV* tie_obj;
HV* tie_obj_stash;
// create an sv and make it a reference to another (new and empty) sv
tie_obj = newSV(0);
newSVrv(tie_obj, NULL);
// bless the reference into the name'd class
tie_obj_stash = gv_stashpv(name, TRUE);
sv_bless(tie_obj, tie_obj_stash);
// tie the blessed object to the name'd scalar
sv_magic(get_sv(name, 1), tie_obj, PERL_MAGIC_tiedscalar, NULL, 0);
}
SV *
ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc)
{
SV *sv;
MAGIC *mg;
if (inc) {
MUTEX_LOCK(&thread->mutex);
thread->count++;
MUTEX_UNLOCK(&thread->mutex);
}
if (!obj)
obj = newSV(0);
sv = newSVrv(obj,classname);
sv_setiv(sv,PTR2IV(thread));
mg = sv_magicext(sv,Nullsv,PERL_MAGIC_shared_scalar,&ithread_vtbl,(char *)thread,0);
mg->mg_flags |= MGf_DUP;
SvREADONLY_on(sv);
return obj;
}
SV *p5_wrap_p6_hash(
PerlInterpreter *my_perl,
IV i
) {
PERL_SET_CONTEXT(my_perl);
{
int flags = G_SCALAR;
dSP;
SV * inst;
SV * inst_ptr;
inst_ptr = newSViv(0); // will be upgraded to an RV
inst = newSVrv(inst_ptr, "Perl6::Object");
_perl6_hash_magic priv;
/* set up magic */
priv.key = PERL6_HASH_MAGIC_KEY;
priv.index = i;
sv_magicext(inst, inst, PERL_MAGIC_ext, &p5_inline_hash_mg_vtbl, (char *) &priv, sizeof(priv));
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(newSVpv("Perl6::Hash", 0));
XPUSHs(inst_ptr);
PUTBACK;
call_method("new", flags);
SPAGAIN;
SV *tied_handle = POPs;
SvREFCNT_inc(tied_handle);
PUTBACK;
FREETMPS;
LEAVE;
return tied_handle;
}
}
SV *p5_wrap_p6_object(PerlInterpreter *my_perl, IV i, SV *p5obj) {
PERL_SET_CONTEXT(my_perl);
{
SV * inst;
SV * inst_ptr;
if (p5obj == NULL) {
inst_ptr = newSViv(0); // will be upgraded to an RV
inst = newSVrv(inst_ptr, "Perl6::Object");
}
else {
inst_ptr = p5obj;
inst = SvRV(inst_ptr);
}
_perl6_magic priv;
/* set up magic */
priv.key = p5obj == NULL ? PERL6_MAGIC_KEY : PERL6_EXTENSION_MAGIC_KEY;
priv.index = i;
sv_magicext(inst, inst, PERL_MAGIC_ext, &p5_inline_mg_vtbl, (char *) &priv, sizeof(priv));
return inst_ptr;
}
}
SV *p5_wrap_p6_object(PerlInterpreter *my_perl, IV i, SV *p5obj, SV *(*call_p6_method)(IV, char * , SV *, SV **), void (*free_p6_object)(IV)) {
SV * inst;
SV * inst_ptr;
if (p5obj == NULL) {
inst_ptr = newSViv(0);
inst = newSVrv(inst_ptr, "Perl6::Object");
}
else {
inst_ptr = p5obj;
inst = SvRV(inst_ptr);
SvREFCNT_inc(inst_ptr);
}
_perl6_magic priv;
/* set up magic */
priv.key = PERL6_MAGIC_KEY;
priv.index = i;
priv.call_p6_method = call_p6_method;
priv.free_p6_object = free_p6_object;
sv_magicext(inst, inst, PERL_MAGIC_ext, &p5_inline_mg_vtbl, (char *) &priv, sizeof(priv));
return inst_ptr;
}
int perl_trapd_handler( netsnmp_pdu *pdu,
netsnmp_transport *transport,
netsnmp_trapd_handler *handler)
{
trapd_cb_data *cb_data;
SV *pcallback;
netsnmp_variable_list *vb;
netsnmp_oid *o;
SV *arg;
SV *rarg;
SV **tmparray;
int i, c = 0;
u_char *outbuf;
size_t ob_len = 0, oo_len = 0;
AV *varbinds;
HV *pduinfo;
dSP;
ENTER;
SAVETMPS;
if (!pdu || !handler)
return 0;
/* nuke v1 PDUs */
if (pdu->command == SNMP_MSG_TRAP)
pdu = convert_v1pdu_to_v2(pdu);
cb_data = handler->handler_data;
if (!cb_data || !cb_data->perl_cb)
return 0;
pcallback = cb_data->perl_cb;
/* get PDU related info */
pduinfo = newHV();
#define STOREPDU(n, v) hv_store(pduinfo, n, strlen(n), v, 0)
#define STOREPDUi(n, v) STOREPDU(n, newSViv(v))
#define STOREPDUs(n, v) STOREPDU(n, newSVpv(v, 0))
STOREPDUi("version", pdu->version);
STOREPDUs("notificationtype", ((pdu->command == SNMP_MSG_INFORM) ? "INFORM":"TRAP"));
STOREPDUi("requestid", pdu->reqid);
STOREPDUi("messageid", pdu->msgid);
STOREPDUi("transactionid", pdu->transid);
STOREPDUi("errorstatus", pdu->errstat);
STOREPDUi("errorindex", pdu->errindex);
if (pdu->version == 3) {
STOREPDUi("securitymodel", pdu->securityModel);
STOREPDUi("securitylevel", pdu->securityLevel);
STOREPDU("contextName",
newSVpv(pdu->contextName, pdu->contextNameLen));
STOREPDU("contextEngineID",
newSVpv(pdu->contextEngineID,
pdu->contextEngineIDLen));
STOREPDU("securityEngineID",
newSVpv(pdu->securityEngineID,
pdu->securityEngineIDLen));
STOREPDU("securityName",
newSVpv(pdu->securityName, pdu->securityNameLen));
} else {
STOREPDU("community",
newSVpv(pdu->community, pdu->community_len));
}
if (transport && transport->f_fmtaddr) {
char *tstr = transport->f_fmtaddr(transport, pdu->transport_data,
pdu->transport_data_length);
STOREPDUs("receivedfrom", tstr);
free(tstr);
}
/*
* collect OID objects in a temp array first
*/
/* get VARBIND related info */
i = count_varbinds(pdu->variables);
tmparray = malloc(sizeof(*tmparray) * i);
for(vb = pdu->variables; vb; vb = vb->next_variable) {
/* get the oid */
o = SNMP_MALLOC_TYPEDEF(netsnmp_oid);
o->name = o->namebuf;
o->len = vb->name_length;
memcpy(o->name, vb->name, vb->name_length * sizeof(oid));
#undef CALL_EXTERNAL_OID_NEW
#ifdef CALL_EXTERNAL_OID_NEW
PUSHMARK(sp);
rarg = sv_2mortal(newSViv((IV) 0));
arg = sv_2mortal(newSVrv(rarg, "netsnmp_oidPtr"));
sv_setiv(arg, (IV) o);
XPUSHs(rarg);
PUTBACK;
i = perl_call_pv("NetSNMP::OID::newwithptr", G_SCALAR);
SPAGAIN;
if (i != 1) {
snmp_log(LOG_ERR, "unhandled OID error.\n");
/* ack XXX */
}
/* get the value */
tmparray[c++] = POPs;
SvREFCNT_inc(tmparray[c-1]);
PUTBACK;
#else /* build it and bless ourselves */
{
HV *hv = newHV();
SV *rv = newRV_noinc((SV *) hv);
SV *rvsub = newRV_noinc((SV *) newSViv((UV) o));
SV *sv;
rvsub = sv_bless(rvsub, gv_stashpv("netsnmp_oidPtr", 1));
hv_store(hv, "oidptr", 6, rvsub, 0);
rv = sv_bless(rv, gv_stashpv("NetSNMP::OID", 1));
tmparray[c++] = rv;
}
#endif /* build oid ourselves */
}
/*
* build the varbind lists
*/
varbinds = newAV();
for(vb = pdu->variables, i = 0; vb; vb = vb->next_variable, i++) {
/* push the oid */
AV *vba;
vba = newAV();
/* get the value */
outbuf = NULL;
ob_len = 0;
oo_len = 0;
sprint_realloc_by_type(&outbuf, &ob_len, &oo_len, 1,
vb, 0, 0, 0);
av_push(vba,tmparray[i]);
av_push(vba,newSVpvn(outbuf, oo_len));
free(outbuf);
av_push(vba,newSViv(vb->type));
av_push(varbinds, (SV *) newRV_noinc((SV *) vba));
}
PUSHMARK(sp);
/* store the collected information on the stack */
XPUSHs(sv_2mortal(newRV_noinc((SV*) pduinfo)));
XPUSHs(sv_2mortal(newRV_noinc((SV*) varbinds)));
/* put the stack back in order */
PUTBACK;
/* actually call the callback function */
if (SvTYPE(pcallback) == SVt_PVCV) {
perl_call_sv(pcallback, G_DISCARD);
/* XXX: it discards the results, which isn't right */
} else if (SvROK(pcallback) && SvTYPE(SvRV(pcallback)) == SVt_PVCV) {
/* reference to code */
perl_call_sv(SvRV(pcallback), G_DISCARD);
} else {
snmp_log(LOG_ERR, " tried to call a perl function but failed to understand its type: (ref = %x, svrok: %lu, SVTYPE: %lu)\n", (uintptr_t)pcallback, SvROK(pcallback), SvTYPE(pcallback));
}
#ifdef DUMPIT
fprintf(stderr, "DUMPDUMPDUMPDUMPDUMPDUMP\n");
sv_dump(pduinfo);
fprintf(stderr, "--------------------\n");
sv_dump(varbinds);
#endif
/* svREFCNT_dec((SV *) pduinfo); */
#ifdef NOT_THIS
{
SV *vba;
while(vba = av_pop(varbinds)) {
av_undef((AV *) vba);
}
}
av_undef(varbinds);
#endif
free(tmparray);
/* Not needed because of the G_DISCARD flag (I think) */
/* SPAGAIN; */
/* PUTBACK; */
#ifndef __x86_64__
FREETMPS; /* FIXME: known to cause a segfault on x86-64 */
#endif
LEAVE;
return NETSNMPTRAPD_HANDLER_OK;
}
/****************************
* 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 * const obj) {
/* elw: see what python says things are */
#if PY_MAJOR_VERSION >= 3
int const is_string = PyBytes_Check(obj) || PyUnicode_Check(obj);
#else
int const is_string = PyString_Check(obj) || PyUnicode_Check(obj);
#endif
#ifdef I_PY_DEBUG
PyObject *this_type = PyObject_Type(obj); /* new reference */
PyObject *t_string = PyObject_Str(this_type); /* new reference */
#if PY_MAJOR_VERSION >= 3
PyObject *type_str_bytes = PyUnicode_AsUTF8String(t_string); /* new reference */
char *type_str = PyBytes_AsString(type_str_bytes);
#else
char *type_str = PyString_AsString(t_string);
#endif
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)));
#if PY_MAJOR_VERSION < 3
Printf(("Class check: %i\n", PyClass_Check(obj)));
Printf(("Instance check: %i\n", PyInstance_Check(obj)));
#endif
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(("Method check: %i\n", PyMethod_Check(obj)));
#if PY_MAJOR_VERSION < 3
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");
#else
Py_DECREF(type_str_bytes);
#endif
Py_DECREF(t_string);
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 * const sub_obj = (SV*)SvRV(((PerlSub_object *) obj)->obj);
HV * const pkg = SvSTASH(sub_obj);
#if PY_MAJOR_VERSION >= 3
char * const sub = PyBytes_AsString(((PerlSub_object *) obj)->sub);
#else
PyObject *obj_sub_str = PyObject_Str(((PerlSub_object *) obj)->sub); /* new ref. */
char * const sub = PyString_AsString(obj_sub_str);
#endif
GV * const gv = Perl_gv_fetchmethod_autoload(aTHX_ pkg, sub, TRUE);
if (gv && isGV(gv)) {
ref = (SV *)GvCV(gv);
}
#if PY_MAJOR_VERSION < 3
Py_DECREF(obj_sub_str);
#endif
}
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)
#if PY_MAJOR_VERSION < 3
|| PyInstance_Check(obj)
#endif
) {
/* 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 * const inst_ptr = newSViv(0);
SV * const inst = newSVrv(inst_ptr, "Inline::Python::Object");;
_inline_magic priv;
/* set up magic */
priv.key = INLINE_MAGIC_KEY;
sv_magic(inst, inst, PERL_MAGIC_ext, (char *) &priv, sizeof(priv));
MAGIC * const mg = mg_find(inst, PERL_MAGIC_ext);
mg->mg_virtual = &inline_mg_vtbl;
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 * const retval = newAV();
int i;
int const sz = PySequence_Length(obj);
Printf(("sequence (%i)\n", sz));
for (i = 0; i < sz; i++) {
PyObject * const tmp = PySequence_GetItem(obj, i); /* new reference */
SV * const 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 * const retval = newHV();
int i;
int const sz = PyMapping_Length(obj);
PyObject * const keys = PyMapping_Keys(obj); /* new reference */
PyObject * const vals = PyMapping_Values(obj); /* new reference */
Printf(("Py2Pl: dict/map\n"));
Printf(("mapping (%i)\n", sz));
for (i = 0; i < sz; i++) {
PyObject * const key = PySequence_GetItem(keys, i), /* new reference */
* const val = PySequence_GetItem(vals, i); /* new reference */
SV * const sv_val = Py2Pl(val);
char * key_val;
if (PyUnicode_Check(key)) {
PyObject * const utf8_string = PyUnicode_AsUTF8String(key); /* new reference */
#if PY_MAJOR_VERSION >= 3
key_val = PyBytes_AsString(utf8_string);
SV * const utf8_key = newSVpv(key_val, PyBytes_Size(utf8_string));
#else
key_val = PyString_AsString(utf8_string);
SV * const utf8_key = newSVpv(key_val, PyString_Size(utf8_string));
#endif
SvUTF8_on(utf8_key);
hv_store_ent(retval, utf8_key, sv_val, 0);
Py_DECREF(utf8_string);
}
else {
PyObject * s = NULL;
#if PY_MAJOR_VERSION >= 3
PyObject * s_bytes = NULL;
if (PyBytes_Check(key)) {
key_val = PyBytes_AsString(key);
#else
if (PyString_Check(key)) {
key_val = PyString_AsString(key);
#endif
}
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.
*/
s = PyObject_Str(key); /* new reference */
#if PY_MAJOR_VERSION >= 3
s_bytes = PyUnicode_AsUTF8String(s); /* new reference */
key_val = PyBytes_AsString(s_bytes);
#else
key_val = PyString_AsString(s);
#endif
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 PY_MAJOR_VERSION >= 3
Py_XDECREF(s_bytes);
#endif
Py_XDECREF(s);
}
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);
}
/* a boolean */
else if (PyBool_Check(obj)) {
SV *
toPerl(USER_OBJECT_ val, Rboolean perlOwned)
{
int n = GET_LENGTH(val);
dTHX;
SV *sv = &sv_undef;
if(val == NULL_USER_OBJECT)
return(sv);
if(isRSReferenceObject(val)){
return(getForeignPerlReference(val));
}
if(GET_LENGTH(GET_CLASS(val))) {
SV *o = userLevelConversionToPerl(val);
if(!o)
return(o);
}
if(n == 1) {
if(IS_CHARACTER(val))
sv = newSVpv(CHAR_DEREF(STRING_ELT(val, 0)), 0);
else if(IS_LOGICAL(val))
sv = newSViv(LOGICAL_DATA(val)[0]);
else if(IS_INTEGER(val))
sv = newSViv(INTEGER_DATA(val)[0]);
else if(IS_NUMERIC(val))
sv = newSVnv(NUMERIC_DATA(val)[0]);
else if(IS_FUNCTION(val))
sv = RPerl_createRProxy(val);
} else {
AV *arr;
int i;
arr = newAV();
SvREFCNT_inc(arr);
if(n > 0)
av_extend(arr, n);
/* Did try using av_make() and storing the SVs in an array first, but didn't fix the problem
of bizarre array.
*/
for(i = 0; i < n ; i++) {
if(IS_CHARACTER(val))
sv = newSVpv(CHAR_DEREF(STRING_ELT(val, i)), 0);
else if(IS_LOGICAL(val))
sv = newSViv(LOGICAL_DATA(val)[i]);
else if(IS_INTEGER(val))
sv = newSViv(INTEGER_DATA(val)[i]);
else if(IS_NUMERIC(val))
sv = newSVnv(NUMERIC_DATA(val)[i]);
SvREFCNT_inc(sv);
av_push(arr, sv);
}
sv = (SV *) arr;
SvREFCNT_dec(arr);
#if 0
{SV *rv = newSVrv(arr, NULL);
sv = rv;
}
#endif
}
if(perlOwned)
#if 0 /*XXX Just experimenting */
sv = sv_2mortal(sv);
#else
sv = SvREFCNT_inc(sv);
#endif
return(sv);
}
