void MarkObjCppOwned(SV *obj) { HV *hv = (HV *) SvRV(obj); SV **sv = hv_fetch(hv, "_cppowned", 9, 0); if (!sv) hv_store(hv, "_cppowned", 9, newSViv(1), 0); } bool IsObjCppOwned(SV *obj) { HV *hv = (HV *) SvRV(obj); SV **sv = hv_fetch(hv, "_cppowned", 9, 0); if (!sv) return false; return true; } SV* PtrToSv(const char* CLASS, void* ptr, SV* dest) { HV* new_hv = newHV(); SV* tmp_rv = newRV_noinc((SV*) new_hv); hv_store(new_hv, "_objptr", 7, newSViv(PTR2IV(ptr)), 0); sv_setsv(dest, sv_bless(tmp_rv, gv_stashpv(CLASS, 1))); SvREFCNT_dec((SV*) tmp_rv); return dest; } template T SvToPtr(SV* src) { T var = NULL; if (sv_isobject(src) && SvTYPE(SvRV(src)) == SVt_PVHV) { HV *hv = (HV *) SvRV(src); SV **sv = hv_fetch(hv, "_objptr", 7, 0); if (sv) { var = INT2PTR(T, SvIV(*sv)); if (!var) { warn("${Package}::$func_name(): C++ object pointer is NULL"); } } else { warn("${Package}::$func_name(): key _objptr is missing"); } } else { warn("${Package}::$func_name(): not a blessed hash reference"); } return var; } wchar_t* SvToWChar(SV* arg) { wchar_t* ret; // Get string length of argument. This works for PV, NV and IV. // The STRLEN typdef is needed to ensure that this will work correctly // in a 64-bit environment. STRLEN arg_len; SvPV(arg, arg_len); // Alloc memory for wide char string. This could be a bit more // then necessary. Newz(0, ret, arg_len + 1, wchar_t); U8* src = (U8*) SvPV_nolen(arg); wchar_t* dst = ret; if (SvUTF8(arg)) { // UTF8 to wide char mapping STRLEN len; while (*src) { *dst++ = utf8_to_uvuni(src, &len); src += len; } } else { // char to wide char mapping while (*src) { *dst++ = (wchar_t) *src++; } } *dst = 0; return ret; } SV* WCharToSv(wchar_t* src, SV* dest) { U8* dst; U8* d; // Alloc memory for wide char string. This is clearly wider // then necessary in most cases but no choice. Newz(0, dst, 3 * wcslen(src) + 1, U8); d = dst; while (*src) { d = uvuni_to_utf8(d, *src++); } *d = 0; sv_setpv(dest, (char*) dst); sv_utf8_decode(dest); Safefree(dst); return dest; } /* Used by the INPUT typemap for char**. * Will convert a Perl AV* (containing strings) to a C char**. */ char ** XS_unpack_charPtrPtr(SV* rv ) { AV *av; SV **ssv; char **s; int avlen; int x; if( SvROK( rv ) && (SvTYPE(SvRV(rv)) == SVt_PVAV) ) av = (AV*)SvRV(rv); else { warn("XS_unpack_charPtrPtr: rv was not an AV ref"); return( (char**)NULL ); } /* is it empty? */ avlen = av_len(av); if( avlen < 0 ){ warn("XS_unpack_charPtrPtr: array was empty"); return( (char**)NULL ); } /* av_len+2 == number of strings, plus 1 for an end-of-array sentinel. */ s = (char **)safemalloc( sizeof(char*) * (avlen + 2) ); if( s == NULL ){ warn("XS_unpack_charPtrPtr: unable to malloc char**"); return( (char**)NULL ); } for( x = 0; x <= avlen; ++x ){ ssv = av_fetch( av, x, 0 ); if( ssv != NULL ){ if( SvPOK( *ssv ) ){ s[x] = (char *)safemalloc( SvCUR(*ssv) + 1 ); if( s[x] == NULL ) warn("XS_unpack_charPtrPtr: unable to malloc char*"); else strcpy( s[x], SvPV( *ssv, PL_na ) ); } else warn("XS_unpack_charPtrPtr: array elem %d was not a string.", x ); } else s[x] = (char*)NULL; } s[x] = (char*)NULL; /* sentinel */ return( s ); } /* Will convert a C char** to a Perl AV* */ void XS_pack_charPtrPtr(SV* st, char **s) { AV *av = newAV(); SV *sv; char **c; for( c = s; *c != NULL; ++c ){ sv = newSVpv( *c, 0 ); av_push( av, sv ); } sv = newSVrv( st, NULL ); /* upgrade stack SV to an RV */ SvREFCNT_dec( sv ); /* discard */ SvRV( st ) = (SV*)av; /* make stack RV point at our AV */ } /* cleanup the temporary char** from XS_unpack_charPtrPtr */ void XS_release_charPtrPtr(char **s) { char **c; for( c = s; *c != NULL; ++c ) safefree( *c ); safefree( s ); }