static amf0_data_t* _amf0_data(SV* sv) {
amf0_data_t* d;
if (NULL == sv || !SvOK(sv)) {
d = (amf0_data_t*)amf0_null_init();
}
else if (SvPOKp(sv)) {
STRLEN len;
char* c = SvPV(sv, len);
d = (amf0_data_t*)amf0_string_init_len(c, len);
}
else if (SvNOKp(sv)) {
d = (amf0_data_t*)amf0_number_init((double)SvNVX(sv));
}
else if (SvIOK_UV(sv)) {
d = (amf0_data_t*)amf0_number_init((double)SvUV(sv));
}
else if (SvIOKp(sv)) {
d = (amf0_data_t*)amf0_number_init((double)SvIV(sv));
}
else if (SvROK(sv)) {
d = _amf0_data_rv(SvRV(sv));
}
else {
Perl_croak(aTHX_ "Data::AMF::XS doesn't support SvTYPE: %d\n", SvTYPE(sv));
}
return d;
}
virtual EModRet OnModuleLoading(const CString& sModName, const CString& sArgs,
CModInfo::EModuleType eType, bool& bSuccess, CString& sRetMsg) {
EModRet result = HALT;
PSTART;
PUSH_STR(sModName);
PUSH_STR(sArgs);
mXPUSHi(eType);
PUSH_PTR(CUser*, GetUser());
PUSH_PTR(CIRCNetwork*, GetNetwork());
PCALL("ZNC::Core::LoadModule");
if (SvTRUE(ERRSV)) {
sRetMsg = PString(ERRSV);
bSuccess = false;
result = HALT;
DEBUG("Perl ZNC::Core::LoadModule died: " << sRetMsg);
} else if (ret < 1 || 2 < ret) {
sRetMsg = "Error: Perl ZNC::Core::LoadModule returned " + CString(ret) + " values.";
bSuccess = false;
result = HALT;
} else {
ELoadPerlMod eLPM = static_cast<ELoadPerlMod>(SvUV(ST(0)));
if (Perl_NotFound == eLPM) {
result = CONTINUE; // Not a Perl module
} else {
sRetMsg = PString(ST(1));
result = HALT;
bSuccess = eLPM == Perl_Loaded;
}
}
PEND;
return result;
}
guint64 amglue_SvU64(SV *sv)
{
if (SvIOK(sv)) {
if (SvIsUV(sv)) {
return SvUV(sv);
} else if (SvIV(sv) < 0) {
croak("Expected an unsigned value, got a negative integer");
return 0;
} else {
return (guint64)SvIV(sv);
}
} else if (SvNOK(sv)) {
double dv = SvNV(sv);
if (dv < 0.0) {
croak("Expected an unsigned value, got a negative integer");
return 0;
} else if (dv > (double)G_MAXUINT64) {
croak("Expected an unsigned 64-bit value or smaller; value out of range");
return 0;
} else {
return (guint64)dv;
}
} else {
return bigint2uint64(sv);
}
}
gint64 amglue_SvI64(SV *sv)
{
if (SvIOK(sv)) {
if (SvIsUV(sv)) {
return SvUV(sv);
} else {
return SvIV(sv);
}
} else if (SvNOK(sv)) {
double dv = SvNV(sv);
/* preprocessor constants seem to have trouble here, so we convert to gint64 and
* back, and if the result differs, then we have lost something. Note that this will
* also error out on integer truncation .. which is probably OK */
gint64 iv = (gint64)dv;
if (dv != (double)iv) {
croak("Expected a signed 64-bit value or smaller; value '%.0f' out of range", (float)dv);
return 0;
} else {
return iv;
}
} else {
return bigint2int64(sv);
}
}
/*
* returns a pointer to a temp stock item you can use until control returns
* to perl.
*/
static GtkStockItem *
SvGtkStockItem (SV * sv)
{
HV * hv;
SV ** svp;
GtkStockItem * item;
if (!gperl_sv_is_hash_ref (sv))
croak ("malformed stock item; use a reference to a hash as a stock item");
hv = (HV*) SvRV (sv);
item = gperl_alloc_temp (sizeof (GtkStockItem));
svp = hv_fetch (hv, "stock_id", 8, FALSE);
if (svp) item->stock_id = SvGChar (*svp);
svp = hv_fetch (hv, "label", 5, FALSE);
if (svp) item->label = SvGChar (*svp);
svp = hv_fetch (hv, "modifier", 8, FALSE);
if (svp) item->modifier = SvGdkModifierType (*svp);
svp = hv_fetch (hv, "keyval", 6, FALSE);
if (svp) item->keyval = SvUV (*svp);
svp = hv_fetch (hv, "translation_domain", 18, FALSE);
if (svp) item->translation_domain = SvGChar (*svp);
return item;
}
static CORBA_boolean
put_ulong (GIOPSendBuffer *buf, SV *sv)
{
CORBA_unsigned_long v = SvUV(sv);
buf_putn (buf, &v, sizeof (v));
return CORBA_TRUE;
}
void plcb_ctor_conversion_opts(PLCB_t *object, AV *options)
{
SV **tmpsv;
AV *methav;
int dummy;
#define meth_assert_getpairs(flag, optidx) \
((object->my_flags & flag) \
? \
(((tmpsv = av_fetch(options, optidx, 0)) && SvROK(*tmpsv) && \
(methav = (AV*)SvRV(*tmpsv))) \
? (void*)1 \
: die("Flag %s specified but no methods provided", #flag)) \
: NULL)
#define meth_assert_assign(target_field, source_idx, diemsg) \
if((tmpsv = av_fetch(methav, source_idx, 0)) == NULL) { \
die("Nothing in IDX=%d (%s)", source_idx, diemsg); \
} \
if(! ((SvROK(*tmpsv) && SvTYPE(SvRV(*tmpsv)) == SVt_PVCV) ) ) { \
die("Expected CODE reference at IDX=%d: %s",source_idx, diemsg); \
} \
object->target_field = newRV_inc(SvRV(*tmpsv));
if( (tmpsv = av_fetch(options, PLCB_CTORIDX_MYFLAGS, 0))
&& SvIOK(*tmpsv)) {
object->my_flags = SvUV(*tmpsv);
}
ctor_extract_methpairs(options, PLCB_CTORIDX_COMP_METHODS,
&object->cv_compress, &object->cv_decompress);
if ((object->my_flags & PLCBf_USE_COMPRESSION) &&
object->cv_compress == NULL) {
die("Compression requested but no methods provided");
}
ctor_extract_methpairs(options, PLCB_CTORIDX_SERIALIZE_METHODS,
&object->cv_serialize, &object->cv_deserialize);
if ((object->my_flags & PLCBf_USE_STORABLE) &&
object->cv_serialize == NULL) {
die("Serialization requested but no methods provided");
}
if ((tmpsv = av_fetch(options, PLCB_CTORIDX_COMP_THRESHOLD, 0))
&& SvIOK(*tmpsv)) {
object->compress_threshold = SvIV(*tmpsv);
} else {
object->compress_threshold = 0;
}
}
/* Builds the C-level configuration and state struct.
* Automatically freed at scope boundary. */
srl_decoder_t *
srl_build_decoder_struct(pTHX_ HV *opt)
{
srl_decoder_t *dec;
SV **svp;
Newxz(dec, 1, srl_decoder_t);
dec->ref_seenhash = PTABLE_new();
dec->max_recursion_depth = DEFAULT_MAX_RECUR_DEPTH;
dec->max_num_hash_entries = 0; /* 0 == any number */
/* load options */
if (opt != NULL) {
if ( (svp = hv_fetchs(opt, "refuse_snappy", 0)) && SvTRUE(*svp))
SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_REFUSE_SNAPPY);
if ( (svp = hv_fetchs(opt, "refuse_objects", 0)) && SvTRUE(*svp))
SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_REFUSE_OBJECTS);
if ( (svp = hv_fetchs(opt, "no_bless_objects", 0)) && SvTRUE(*svp))
SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_NO_BLESS_OBJECTS);
if ( (svp = hv_fetchs(opt, "validate_utf8", 0)) && SvTRUE(*svp))
SRL_DEC_SET_OPTION(dec, SRL_F_DECODER_VALIDATE_UTF8);
if ( (svp = hv_fetchs(opt, "max_recursion_depth", 0)) && SvTRUE(*svp))
dec->max_recursion_depth = SvUV(*svp);
if ( (svp = hv_fetchs(opt, "max_num_hash_entries", 0)) && SvTRUE(*svp))
dec->max_num_hash_entries = SvUV(*svp);
if ( (svp = hv_fetchs(opt, "incremental", 0)) && SvTRUE(*svp))
SRL_DEC_SET_OPTION(dec,SRL_F_DECODER_DESTRUCTIVE_INCREMENTAL);
}
return dec;
}
void jperl_destroy(pTHX_ CV *cv)
{
dXSARGS;
SV *sv=get_sv("jperl::internal::jni", SVf_UTF8);
SV *self;
jobject o;
JNIEnv *env;
if(sv==NULL)
{
croak("jperl::internal::jni not initialized");
XSRETURN_UNDEF;
}
if(items!=1)
{
croak_xs_usage(cv, "self");
XSRETURN_UNDEF;
}
env=(JNIEnv*)SvUV(sv);
self=SvRV(ST(0));
o=(jobject)SvUV(self);
(*env)->DeleteGlobalRef(env, o);
XSRETURN_UNDEF;
}
virtual EModRet OnGetModInfo(CModInfo& ModInfo, const CString& sModule,
bool& bSuccess, CString& sRetMsg) {
PSTART;
PUSH_STR(sModule);
PCALL("ZNC::Core::GetModInfo");
EModRet result = CONTINUE;
if (SvTRUE(ERRSV)) {
bSuccess = false;
sRetMsg = PString(ERRSV);
} else if (0 < ret) {
switch(static_cast<ELoadPerlMod>(SvUV(ST(0)))) {
case Perl_NotFound:
result = CONTINUE;
break;
case Perl_Loaded:
result = HALT;
if (3 == ret) {
ModInfo.SetGlobal(false);
ModInfo.SetDescription(PString(ST(2)));
ModInfo.SetName(sModule);
ModInfo.SetPath(PString(ST(1)));
bSuccess = true;
} else {
bSuccess = false;
sRetMsg = "Something weird happened";
}
break;
case Perl_LoadError:
result = HALT;
bSuccess = false;
if (2 == ret) {
sRetMsg = PString(ST(1));
} else {
sRetMsg = "Something weird happened";
}
}
} else {
result = HALT;
bSuccess = false;
sRetMsg = "Something weird happened";
}
PEND;
DEBUG(__PRETTY_FUNCTION__ << " " << sRetMsg);
return result;
}
ELoadPerlMod LoadPerlModule(const CString& sModule, const CString& sArgs, CUser* pUser, CString& sRetMsg) {
ELoadPerlMod result = Perl_LoadError;
PSTART;
PUSH_STR(sModule);
PUSH_STR(sArgs);
PUSH_PTR(CUser*, pUser);
PCALL("ZNC::Core::LoadModule");
if (SvTRUE(ERRSV)) {
sRetMsg = PString(ERRSV);
} else if (2 == ret) {
result = static_cast<ELoadPerlMod>(SvUV(ST(0)));
sRetMsg = PString(ST(1));
}
DEBUG(__PRETTY_FUNCTION__ << " " << sRetMsg);
PEND;
return result;
}
static IvrPython* getIvrPythonPointer(){
IvrPython* pIvrPython = NULL;
#ifndef IVR_PERL
PyObject *module = PyImport_ImportModule(PY_MOD_NAME);
if (module != NULL) {
PyObject *ivrPythonPointer = PyObject_GetAttrString(module, "ivrPythonPointer");
if (ivrPythonPointer != NULL){
if (PyCObject_Check(ivrPythonPointer))
pIvrPython = (IvrPython*)PyCObject_AsVoidPtr(ivrPythonPointer);
Py_DECREF(ivrPythonPointer);
}
}
#else //IVR_PERL
SV* pivr = get_sv("Ivr::__ivrpointer__", FALSE);
if (pivr != NULL)
pIvrPython = (IvrPython *) SvUV(pivr);
#endif //IVR_PERL
return pIvrPython;
}
virtual EModRet OnGetModInfo(CModInfo& ModInfo, const CString& sModule,
bool& bSuccess, CString& sRetMsg) {
PSTART;
PUSH_STR(sModule);
PUSH_PTR(CModInfo*, &ModInfo);
PCALL("ZNC::Core::GetModInfo");
EModRet result = CONTINUE;
if (SvTRUE(ERRSV)) {
bSuccess = false;
sRetMsg = PString(ERRSV);
} else if (0 < ret) {
switch(static_cast<ELoadPerlMod>(SvUV(ST(0)))) {
case Perl_NotFound:
result = CONTINUE;
break;
case Perl_Loaded:
result = HALT;
if (1 == ret) {
bSuccess = true;
} else {
bSuccess = false;
sRetMsg = "Something weird happened";
}
break;
case Perl_LoadError:
result = HALT;
bSuccess = false;
if (2 == ret) {
sRetMsg = PString(ST(1));
} else {
sRetMsg = "Something weird happened";
}
}
} else {
result = HALT;
bSuccess = false;
sRetMsg = "Something weird happened";
}
PEND;
return result;
}
void
PLCB__viewhandle_stop(SV *pp)
{
AV *req = (AV *)SvRV(pp);
PLCB_t *parent = parent_from_req(req);
SV **tmp, *vhsv;
tmp = av_fetch(req, PLCB_VHIDX_VHANDLE, 0);
if (!tmp) {
return;
}
vhsv = *tmp;
if (SvIOK(vhsv)) {
lcb_VIEWHANDLE vh = NUM2PTR(lcb_VIEWHANDLE, SvUV(vhsv));
lcb_view_cancel(parent->instance, vh);
av_store(req, PLCB_VHIDX_VHANDLE, SvREFCNT_inc(&PL_sv_undef));
av_store(req, PLCB_VHIDX_ISDONE, SvREFCNT_inc(&PL_sv_yes));
SvREFCNT_dec((SV *)req);
}
}
static SV *
custom_convert(AV *docav, SV *meth, SV *input, uint32_t *flags, int direction)
{
dSP;
SV *ret;
SV *flags_rv;
SV *input_rv;
int callflags;
ENTER; SAVETMPS;
PUSHMARK(SP);
input_rv = sv_2mortal(newRV_inc(input));
flags_rv = sv_2mortal(newRV_noinc(newSVuv(*flags)));
XPUSHs(sv_2mortal(newRV_inc( (SV *)docav)));
XPUSHs(input_rv);
XPUSHs(flags_rv);
PUTBACK;
callflags = G_VOID|G_DISCARD;
if (direction == CONVERT_OUT) {
callflags |= G_EVAL;
}
call_sv(meth, callflags);
SPAGAIN;
if (SvTRUE(ERRSV)) {
ret = input;
} else {
warn("Conversion function failed");
ret = SvRV(input_rv);
*flags = SvUV(SvRV(flags_rv));
}
SvREFCNT_inc(ret);
return ret;
}
static void
XS_Fcntl_S_ISREG(pTHX_ CV* cv)
{
dVAR;
dXSARGS;
dXSI32;
/* Preserve the semantics of the perl code, which was:
sub S_ISREG { ( $_[0] & _S_IFMT() ) == S_IFREG() }
*/
SV *mode;
PERL_UNUSED_VAR(cv); /* -W */
SP -= items;
if (items > 0)
mode = ST(0);
else {
mode = &PL_sv_undef;
EXTEND(SP, 1);
}
PUSHs(((SvUV(mode) & S_IFMT) == (UV)ix) ? &PL_sv_yes : &PL_sv_no);
PUTBACK;
}
/* transfer and may_be_null can be gotten from arg_info, but sv_to_arg is also
* called from places which don't have access to a GIArgInfo. */
static void
sv_to_arg (SV * sv,
GIArgument * arg,
GIArgInfo * arg_info,
GITypeInfo * type_info,
GITransfer transfer,
gboolean may_be_null,
GPerlI11nInvocationInfo * invocation_info)
{
GITypeTag tag = g_type_info_get_tag (type_info);
if (!gperl_sv_is_defined (sv))
/* Interfaces and void types need to be able to handle undef
* separately. */
if (!may_be_null && tag != GI_TYPE_TAG_INTERFACE
&& tag != GI_TYPE_TAG_VOID) {
if (arg_info) {
ccroak ("undefined value for mandatory argument '%s' encountered",
g_base_info_get_name ((GIBaseInfo *) arg_info));
} else {
ccroak ("undefined value encountered");
}
}
switch (tag) {
case GI_TYPE_TAG_VOID:
/* returns NULL if no match is found */
arg->v_pointer = sv_to_callback_data (sv, invocation_info);
break;
case GI_TYPE_TAG_BOOLEAN:
arg->v_boolean = SvTRUE (sv);
break;
case GI_TYPE_TAG_INT8:
arg->v_int8 = (gint8) SvIV (sv);
break;
case GI_TYPE_TAG_UINT8:
arg->v_uint8 = (guint8) SvUV (sv);
break;
case GI_TYPE_TAG_INT16:
arg->v_int16 = (gint16) SvIV (sv);
break;
case GI_TYPE_TAG_UINT16:
arg->v_uint16 = (guint16) SvUV (sv);
break;
case GI_TYPE_TAG_INT32:
arg->v_int32 = (gint32) SvIV (sv);
break;
case GI_TYPE_TAG_UINT32:
arg->v_uint32 = (guint32) SvUV (sv);
break;
case GI_TYPE_TAG_INT64:
arg->v_int64 = SvGInt64 (sv);
break;
case GI_TYPE_TAG_UINT64:
arg->v_uint64 = SvGUInt64 (sv);
break;
case GI_TYPE_TAG_FLOAT:
arg->v_float = (gfloat) SvNV (sv);
break;
case GI_TYPE_TAG_DOUBLE:
arg->v_double = SvNV (sv);
break;
case GI_TYPE_TAG_UNICHAR:
arg->v_uint32 = g_utf8_get_char (SvGChar (sv));
break;
case GI_TYPE_TAG_GTYPE:
/* GType == gsize */
arg->v_size = gperl_type_from_package (SvPV_nolen (sv));
if (!arg->v_size)
arg->v_size = g_type_from_name (SvPV_nolen (sv));
break;
case GI_TYPE_TAG_ARRAY:
arg->v_pointer = sv_to_array (transfer, type_info, sv, invocation_info);
break;
case GI_TYPE_TAG_INTERFACE:
dwarn (" type %p -> interface\n", type_info);
sv_to_interface (arg_info, type_info, transfer, may_be_null,
sv, arg, invocation_info);
break;
case GI_TYPE_TAG_GLIST:
case GI_TYPE_TAG_GSLIST:
arg->v_pointer = sv_to_glist (transfer, type_info, sv);
break;
case GI_TYPE_TAG_GHASH:
arg->v_pointer = sv_to_ghash (transfer, type_info, sv);
break;
case GI_TYPE_TAG_ERROR:
ccroak ("FIXME - A GError as an in/inout arg? Should never happen!");
break;
case GI_TYPE_TAG_UTF8:
arg->v_string = gperl_sv_is_defined (sv) ? SvGChar (sv) : NULL;
if (transfer >= GI_TRANSFER_CONTAINER)
arg->v_string = g_strdup (arg->v_string);
break;
case GI_TYPE_TAG_FILENAME:
/* FIXME: Should we use SvPVbyte_nolen here? */
arg->v_string = gperl_sv_is_defined (sv) ? SvPV_nolen (sv) : NULL;
if (transfer >= GI_TRANSFER_CONTAINER)
arg->v_string = g_strdup (arg->v_string);
break;
default:
ccroak ("Unhandled info tag %d in sv_to_arg", tag);
}
}
static int
convert_valspec(plcb_OPTION *dst, SV *src)
{
switch (dst->type) {
case PLCB_ARG_T_PAD:
return 0;
case PLCB_ARG_T_INT:
case PLCB_ARG_T_BOOL: {
int assigned_val = 0;
if (SvTYPE(src) == SVt_NULL) {
assigned_val = 0;
} else {
assigned_val = SvIV(src);
}
*((int*)(dst->value)) = assigned_val;
break;
}
#define EXPECT_RV(subtype, friendly_name) \
if (SvROK(src) == 0 || SvTYPE(SvRV(src)) != subtype) { \
die("Expected %s for %s", friendly_name, dst->key); \
} \
*(void**)dst->value = src;
case PLCB_ARG_T_SV:
*(SV**)dst->value = src;
break;
case PLCB_ARG_T_HV:
EXPECT_RV(SVt_PVHV, "Hash");
break;
case PLCB_ARG_T_AV:
EXPECT_RV(SVt_PVAV, "Array");
break;
case PLCB_ARG_T_CV:
EXPECT_RV(SVt_PVCV, "CODE");
break;
#undef EXPECT_RV
case PLCB_ARG_T_RV:
if (!SvROK(src)) {
die("Expected reference for %s", dst->key);
}
*(SV**)dst->value = src;
break;
case PLCB_ARG_T_CAS: {
if (SvTYPE(src) == SVt_NULL) {
break;
}
*(uint64_t*)dst->value = plcb_sv2cas(src);
break;
}
case PLCB_ARG_T_EXP:
case PLCB_ARG_T_EXPTT: {
UV exp_uv = plcb_exp_from_sv(src);
if (dst->type == PLCB_ARG_T_EXP) {
*((UV*)dst->value) = exp_uv;
} else {
*(time_t*)dst->value = exp_uv;
}
break;
}
case PLCB_ARG_T_I64:
*(int64_t*)dst->value = plcb_sv_to_64(src);
break;
case PLCB_ARG_T_U64:
*(uint64_t*)dst->value = plcb_sv_to_u64(src);
break;
case PLCB_ARG_T_U32:
*(uint32_t*)dst->value = SvUV(src);
break;
case PLCB_ARG_T_STRING:
case PLCB_ARG_T_STRING_NN: {
PLCB_XS_STRING_t *str = dst->value;
str->origsv = src;
str->base = SvPV(src, str->len);
if (str->len == 0 && dst->type == PLCB_ARG_T_STRING_NN) {
die("Value cannot be an empty string for %s", dst->key);
}
break;
}
case PLCB_ARG_T_CSTRING:
case PLCB_ARG_T_CSTRING_NN: {
*(const char **)dst->value = SvPV_nolen(src);
if (dst->type == PLCB_ARG_T_CSTRING_NN) {
if (dst->value == NULL|| *(const char*)dst->value == '\0') {
die("Value passed must not be empty for %s", dst->key);
}
}
break;
}
default:
return -1;
break;
}
return 0;
}
SV* primesieve(SV *start_sv, SV *limit_sv, int run_mode, int fd)
{
AV *ret;
uint64_t n_ret, start, limit, *primes;
size_t size, i;
int err;
#ifdef __LP64__
start = SvUV(start_sv);
limit = SvUV(limit_sv);
#else
start = strtoull(SvPV_nolen(start_sv), NULL, 10);
limit = strtoull(SvPV_nolen(limit_sv), NULL, 10);
#endif
ret = newAV(), n_ret = 0, err = 0;
//====================================================================
// Count primes, sum primes, otherwise output primes for this block.
//====================================================================
if (run_mode == MODE_COUNT) {
n_ret = primesieve_count_primes(start, limit);
}
else {
primes = primesieve_generate_primes(start, limit, &size, UINT64_PRIMES);
if (run_mode == MODE_SUM) {
for (i = 0; i < size; i++)
n_ret += primes[i];
}
else {
char *buf; int len;
buf = (char *) malloc(sizeof(char) * (FLUSH_LIMIT + 216));
len = 0;
for (i = 0; i < size; i++) {
if ((err = write_output(fd, buf, primes[i], &len)))
break;
}
if (!err)
err = flush_output(fd, buf, &len);
free((void *) buf);
buf = NULL;
}
primesieve_free(primes);
}
//====================================================================
// Return.
//====================================================================
if (run_mode == MODE_PRINT) {
av_push(ret, newSViv(err));
}
else {
#ifdef __LP64__
av_push(ret, newSVuv(n_ret));
#else
SV *n_sv; char *ptr; STRLEN len; int n_chars;
n_sv = newSVpvn("", N_MAXDIGITS);
ptr = SvPV(n_sv, len);
n_chars = sprintull(ptr, n_ret);
av_push(ret, newSVpvn(ptr, n_chars));
#endif
}
return newRV_noinc((SV *) ret);
}
static void *
perl_signal_cb(va_list args, void *data)
{
PurplePerlSignalHandler *handler = data;
void *ret_val = NULL;
int i;
int count;
int value_count;
PurpleValue *ret_value, **values;
SV **sv_args;
DATATYPE **copy_args;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(sp);
purple_signal_get_values(handler->instance, handler->signal,
&ret_value, &value_count, &values);
sv_args = g_new(SV *, value_count);
copy_args = g_new(void **, value_count);
for (i = 0; i < value_count; i++) {
sv_args[i] = purple_perl_sv_from_vargs(values[i],
#ifdef VA_COPY_AS_ARRAY
args,
#else
(va_list*)&args,
#endif
©_args[i]);
XPUSHs(sv_args[i]);
}
XPUSHs((SV *)handler->data);
PUTBACK;
if (ret_value != NULL) {
count = call_sv(handler->callback, G_EVAL | G_SCALAR);
SPAGAIN;
if (count != 1)
croak("Uh oh! call_sv returned %i != 1", i);
else
ret_val = purple_perl_data_from_sv(ret_value, POPs);
} else {
call_sv(handler->callback, G_EVAL | G_SCALAR);
SPAGAIN;
}
if (SvTRUE(ERRSV)) {
purple_debug_error("perl",
"Perl function exited abnormally: %s\n",
SvPVutf8_nolen(ERRSV));
}
/* See if any parameters changed. */
for (i = 0; i < value_count; i++) {
if (purple_value_is_outgoing(values[i])) {
switch (purple_value_get_type(values[i])) {
case PURPLE_TYPE_BOOLEAN:
*((gboolean *)copy_args[i]) = SvIV(sv_args[i]);
break;
case PURPLE_TYPE_INT:
*((int *)copy_args[i]) = SvIV(sv_args[i]);
break;
case PURPLE_TYPE_UINT:
*((unsigned int *)copy_args[i]) = SvUV(sv_args[i]);
break;
case PURPLE_TYPE_LONG:
*((long *)copy_args[i]) = SvIV(sv_args[i]);
break;
case PURPLE_TYPE_ULONG:
*((unsigned long *)copy_args[i]) = SvUV(sv_args[i]);
break;
case PURPLE_TYPE_INT64:
*((gint64 *)copy_args[i]) = SvIV(sv_args[i]);
break;
case PURPLE_TYPE_UINT64:
*((guint64 *)copy_args[i]) = SvUV(sv_args[i]);
break;
case PURPLE_TYPE_STRING:
if (strcmp(*((char **)copy_args[i]), SvPVX(sv_args[i]))) {
g_free(*((char **)copy_args[i]));
*((char **)copy_args[i]) =
g_strdup(SvPVutf8_nolen(sv_args[i]));
}
/* Clean up sv_args[i] - we're done with it */
sv_2mortal(sv_args[i]);
break;
case PURPLE_TYPE_POINTER:
case PURPLE_TYPE_BOXED:
*((void **)copy_args[i]) = (void *)SvIV(sv_args[i]);
break;
case PURPLE_TYPE_SUBTYPE:
*((void **)copy_args[i]) = purple_perl_ref_object(sv_args[i]);
break;
default:
break;
}
#if 0
*((void **)copy_args[i]) = purple_perl_data_from_sv(values[i],
sv_args[i]);
#endif
}
}
PUTBACK;
FREETMPS;
LEAVE;
g_free(sv_args);
g_free(copy_args);
purple_debug_misc("perl", "ret_val = %p\n", ret_val);
return ret_val;
}
unsigned long dubul (SV* in) {
return (SvUV(in) * 2);
}
srl_splitter_t * srl_build_splitter_struct(pTHX_ HV *opt) {
srl_splitter_t *splitter;
SV **svp;
STRLEN input_len;
splitter = srl_empty_splitter_struct(aTHX);
/* load options */
svp = hv_fetchs(opt, "input", 0);
if (svp && SvOK(*svp)) {
splitter->input_str = SvPV(*svp, input_len);
splitter->pos = splitter->input_str;
splitter->input_len = input_len;
splitter->input_str_end = splitter->input_str + input_len;
splitter->input_sv = SvREFCNT_inc(*svp);
SRL_SPLITTER_TRACE("input_size %" UVuf, input_len);
} else {
croak ("no input given");
}
svp = hv_fetchs(opt, "chunk_size", 0);
if (svp && SvOK(*svp)) {
splitter->size_limit = SvUV(*svp);
SRL_SPLITTER_TRACE("size_limit %" UVuf, splitter->size_limit);
}
splitter->compression_format = 0;
svp = hv_fetchs(opt, "compress", 0);
if (svp && SvOK(*svp)) {
IV compression_format = SvIV(*svp);
/* See also Splitter.pm's constants */
switch (compression_format) {
case 0:
SRL_SPLITTER_TRACE("no compression %s", "");
break;
case 1:
croak("incremental snappy compression not yet supported. Try gzip");
break;
case 2:
splitter->compression_format = 2;
SRL_SPLITTER_TRACE("gzip compression %s", "");
break;
default:
croak("invalid valie for 'compress' parameter");
}
}
splitter->header_str = NULL;
splitter->header_sv = NULL;
splitter->header_len = 0;
svp = hv_fetchs(opt, "header_data_template", 0);
if (svp && SvOK(*svp)) {
STRLEN header_len;
splitter->header_str = SvPV(*svp, header_len);
splitter->header_sv = SvREFCNT_inc(*svp);
splitter->header_len = header_len;
SRL_SPLITTER_TRACE("header_data_template found, of length %lu", header_len);
}
splitter->header_count_idx = -1;
svp = hv_fetchs(opt, "header_count_idx", 0);
if (svp && SvOK(*svp)) {
splitter->header_count_idx = SvIV(*svp);
SRL_SPLITTER_TRACE("header_count_idx found, %ld", splitter->header_count_idx);
}
_parse_header(aTHX_ splitter);
/* initialize stacks */
srl_splitter_stack_t * status_stack;
Newxz(status_stack, 1, srl_splitter_stack_t );
Newxz(status_stack->data, STACK_SIZE_INCR, UV );
status_stack->size = STACK_SIZE_INCR;
status_stack->top = 0;
splitter->status_stack = status_stack;
/* initialize */
splitter->deepness = 0;
char tag = *(splitter->pos);
splitter->pos++;
if (IS_SRL_HDR_ARRAYREF(tag)) {
int len = tag & 0xF;
splitter->input_nb_elts = len;
SRL_SPLITTER_TRACE(" * ARRAYREF of len, %d", len);
while (len-- > 0) {
stack_push(splitter->status_stack, ST_VALUE);
}
} else if (tag == SRL_HDR_REFN) {
tag = *(splitter->pos);
splitter->pos++;
if (tag == SRL_HDR_ARRAY) {
UV len = _read_varint_uv_nocheck(splitter);
splitter->input_nb_elts = len;
SRL_SPLITTER_TRACE(" * ARRAY of len, %lu", len);
while (len-- > 0) {
stack_push(splitter->status_stack, ST_VALUE);
}
} else {
croak("first tag is REFN but next tag is not ARRAY");
}
} else {
croak("first tag is not an ArrayRef");
}
/* now splitter->pos is on the first array element */
return splitter;
}
unsigned long swiftperl_svuv(void *vp) {
return (unsigned long)SvUV((SV *)vp);
}
STATIC I32
S_do_trans_simple_utf8(pTHX_ SV * const sv)
{
dVAR;
U8 *s;
U8 *send;
U8 *d;
U8 *start;
U8 *dstart, *dend;
I32 matches = 0;
const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
STRLEN len;
SV* const rv =
#ifdef USE_ITHREADS
PAD_SVl(cPADOP->op_padix);
#else
(SV*)cSVOP->op_sv;
#endif
HV* const hv = (HV*)SvRV(rv);
SV* const * svp = hv_fetchs(hv, "NONE", FALSE);
const UV none = svp ? SvUV(*svp) : 0x7fffffff;
const UV extra = none + 1;
UV final = 0;
U8 hibit = 0;
s = (U8*)SvPV(sv, len);
if (!SvUTF8(sv)) {
const U8 *t = s;
const U8 * const e = s + len;
while (t < e) {
const U8 ch = *t++;
hibit = !NATIVE_IS_INVARIANT(ch);
if (hibit) {
s = bytes_to_utf8(s, &len);
break;
}
}
}
send = s + len;
start = s;
svp = hv_fetchs(hv, "FINAL", FALSE);
if (svp)
final = SvUV(*svp);
if (grows) {
/* d needs to be bigger than s, in case e.g. upgrading is required */
Newx(d, len * 3 + UTF8_MAXBYTES, U8);
dend = d + len * 3;
dstart = d;
}
else {
dstart = d = s;
dend = d + len;
}
while (s < send) {
const UV uv = swash_fetch(rv, s, TRUE);
if (uv < none) {
s += UTF8SKIP(s);
matches++;
d = uvuni_to_utf8(d, uv);
}
else if (uv == none) {
const int i = UTF8SKIP(s);
Move(s, d, i, U8);
d += i;
s += i;
}
else if (uv == extra) {
s += UTF8SKIP(s);
matches++;
d = uvuni_to_utf8(d, final);
}
else
srl_merger_t *
srl_build_merger_struct(pTHX_ HV *opt)
{
srl_merger_t *mrg;
SV **svp;
int i;
mrg = srl_empty_merger_struct(aTHX);
/* load options */
if (opt != NULL) {
/* Needs to be before the snappy options */
/* mrg->protocol_version defaults to SRL_PROTOCOL_VERSION. */
svp = hv_fetchs(opt, "protocol_version", 0);
if (svp && SvOK(*svp)) {
mrg->protocol_version = SvUV(*svp);
if (mrg->protocol_version < 1 || mrg->protocol_version > SRL_PROTOCOL_VERSION) {
croak("Specified Sereal protocol version ('%lu') is invalid",
(unsigned long) mrg->protocol_version);
}
}
svp = hv_fetchs(opt, "top_level_element", 0);
if (svp && SvOK(*svp)) {
switch (SvUV(*svp)) {
case 0: /* SCALAR */
SRL_MRG_SET_OPTION(mrg, SRL_F_TOPLEVEL_KEY_SCALAR);
break;
case 1: /* ARRAYREF */
SRL_MRG_SET_OPTION(mrg, SRL_F_TOPLEVEL_KEY_ARRAY);
break;
case 2: /* HASHREF */
SRL_MRG_SET_OPTION(mrg, SRL_F_TOPLEVEL_KEY_HASH);
break;
default:
croak("Invalid Sereal::Merger top level element");
}
}
svp = hv_fetchs(opt, "dedupe_strings", 0);
if (svp && SvTRUE(*svp))
SRL_MRG_SET_OPTION(mrg, SRL_F_DEDUPE_STRINGS);
svp = hv_fetchs(opt, "compress", 0);
if (svp && SvOK(*svp)) {
switch (SvIV(*svp)) {
case 0: /* uncompressed */
break;
case 1: /* snappy incremental */
SRL_MRG_SET_OPTION(mrg, SRL_F_COMPRESS_SNAPPY_INCREMENTAL);
break;
default:
croak("Invalid Sereal compression format");
}
}
svp = hv_fetchs(opt, "max_recursion_depth", 0);
if (svp && SvOK(*svp))
mrg->max_recursion_depth = SvUV(*svp);
}
if (mrg->protocol_version == 1) {
srl_fill_header(aTHX_ mrg, NULL, 0);
} else {
/* Preallocate memory for buffer.
* SRL_PREALLOCATE_FOR_USER_HEADER for potential user header + 100 bytes for body */
GROW_BUF(&mrg->obuf, SRL_PREALLOCATE_FOR_USER_HEADER + 100);
mrg->obuf.pos = mrg->obuf.start + SRL_PREALLOCATE_FOR_USER_HEADER;
SRL_UPDATE_BODY_POS(&mrg->obuf, mrg->protocol_version);
}
if (!SRL_MRG_HAVE_OPTION(mrg, SRL_F_TOPLEVEL_KEY_SCALAR)) {
srl_buf_cat_char_nocheck(&mrg->obuf, SRL_HDR_REFN);
srl_buf_cat_char_nocheck(&mrg->obuf, SRL_MRG_HAVE_OPTION(mrg, SRL_F_TOPLEVEL_KEY_HASH) ? SRL_HDR_HASH : SRL_HDR_ARRAY);
mrg->obuf_padding_bytes_offset = BUF_POS_OFS(&mrg->obuf);
for (i = 0; i < SRL_MAX_VARINT_LENGTH_U32; ++i) {
srl_buf_cat_char_nocheck(&mrg->obuf, SRL_HDR_PAD);
}
}
return mrg;
}
/* Builds the C-level configuration and state struct. */
srl_encoder_t *
srl_build_encoder_struct(pTHX_ HV *opt)
{
srl_encoder_t *enc;
SV **svp;
enc = srl_empty_encoder_struct(aTHX);
enc->flags = 0;
/* load options */
if (opt != NULL) {
int undef_unknown = 0;
/* SRL_F_SHARED_HASHKEYS on by default */
svp = hv_fetchs(opt, "no_shared_hashkeys", 0);
if ( !svp || !SvTRUE(*svp) )
enc->flags |= SRL_F_SHARED_HASHKEYS;
svp = hv_fetchs(opt, "croak_on_bless", 0);
if ( svp && SvTRUE(*svp) )
enc->flags |= SRL_F_CROAK_ON_BLESS;
svp = hv_fetchs(opt, "snappy", 0);
if ( svp && SvTRUE(*svp) )
enc->flags |= SRL_F_COMPRESS_SNAPPY;
svp = hv_fetchs(opt, "snappy_incr", 0);
if ( svp && SvTRUE(*svp) )
enc->flags |= SRL_F_COMPRESS_SNAPPY_INCREMENTAL;
svp = hv_fetchs(opt, "undef_unknown", 0);
if ( svp && SvTRUE(*svp) ) {
undef_unknown = 1;
enc->flags |= SRL_F_UNDEF_UNKNOWN;
}
svp = hv_fetchs(opt, "sort_keys", 0);
if ( svp && SvTRUE(*svp) ) {
enc->flags |= SRL_F_SORT_KEYS;
}
svp = hv_fetchs(opt, "stringify_unknown", 0);
if ( svp && SvTRUE(*svp) ) {
if (expect_false( undef_unknown )) {
croak("'undef_unknown' and 'stringify_unknown' "
"options are mutually exclusive");
}
enc->flags |= SRL_F_STRINGIFY_UNKNOWN;
}
svp = hv_fetchs(opt, "warn_unknown", 0);
if ( svp && SvTRUE(*svp) ) {
enc->flags |= SRL_F_WARN_UNKNOWN;
if (SvIV(*svp) < 0)
enc->flags |= SRL_F_NOWARN_UNKNOWN_OVERLOAD;
}
svp = hv_fetchs(opt, "snappy_threshold", 0);
if ( svp && SvOK(*svp) )
enc->snappy_threshold = SvIV(*svp);
else
enc->snappy_threshold = 1024;
svp = hv_fetchs(opt, "max_recursion_depth", 0);
if ( svp && SvTRUE(*svp))
enc->max_recursion_depth = SvUV(*svp);
}
else {
/* SRL_F_SHARED_HASHKEYS on by default */
enc->flags |= SRL_F_SHARED_HASHKEYS;
}
DEBUG_ASSERT_BUF_SANE(enc);
return enc;
}
/* This callback is only ever called for single operation, single key results */
static void
callback_common(lcb_t instance, int cbtype, const lcb_RESPBASE *resp)
{
AV *resobj = NULL;
PLCB_t *parent;
SV *ctxrv = (SV *)resp->cookie;
plcb_OPCTX *ctx = NUM2PTR(plcb_OPCTX*, SvIVX(SvRV(ctxrv)));
if (cbtype == LCB_CALLBACK_STATS || cbtype == LCB_CALLBACK_OBSERVE ||
cbtype == LCB_CALLBACK_HTTP) {
HE *tmp;
hv_iterinit(ctx->docs);
tmp = hv_iternext(ctx->docs);
if (tmp && HeVAL(tmp) && SvROK(HeVAL(tmp))) {
resobj = (AV *)SvRV(HeVAL(tmp));
}
} else {
SV **tmp = hv_fetch(ctx->docs, resp->key, resp->nkey, 0);
if (tmp && SvROK(*tmp)) {
resobj = (AV*)SvRV(*tmp);
}
}
if (!resobj) {
warn("Couldn't find matching object!");
return;
}
parent = (PLCB_t *)lcb_get_cookie(instance);
plcb_doc_set_err(parent, resobj, resp->rc);
switch (cbtype) {
case LCB_CALLBACK_GET: {
const lcb_RESPGET *gresp = (const lcb_RESPGET *)resp;
if (resp->rc == LCB_SUCCESS) {
SV *newval = plcb_convert_retrieval(parent,
resobj, gresp->value, gresp->nvalue, gresp->itmflags);
av_store(resobj, PLCB_RETIDX_VALUE, newval);
plcb_doc_set_cas(parent, resobj, &resp->cas);
}
break;
}
case LCB_CALLBACK_TOUCH:
case LCB_CALLBACK_REMOVE:
case LCB_CALLBACK_UNLOCK:
case LCB_CALLBACK_STORE:
case LCB_CALLBACK_ENDURE:
if (resp->cas && resp->rc == LCB_SUCCESS) {
plcb_doc_set_cas(parent, resobj, &resp->cas);
}
if (cbtype == LCB_CALLBACK_STORE && resp->rc == LCB_SUCCESS &&
chain_endure(parent, resobj, (const lcb_RESPSTORE *)resp)) {
return; /* Will be handled already */
}
break;
case LCB_CALLBACK_COUNTER: {
const lcb_RESPCOUNTER *cresp = (const lcb_RESPCOUNTER*)resp;
plcb_doc_set_numval(parent, resobj, cresp->value, resp->cas);
break;
}
case LCB_CALLBACK_STATS: {
const lcb_RESPSTATS *sresp = (const void *)resp;
if (sresp->server) {
call_helper(resobj, cbtype, (const lcb_RESPBASE *)sresp);
return;
}
break;
}
case LCB_CALLBACK_OBSERVE: {
const lcb_RESPOBSERVE *oresp = (const lcb_RESPOBSERVE*)resp;
if (oresp->nkey) {
call_helper(resobj, cbtype, (const lcb_RESPBASE*)oresp);
return;
}
break;
}
case LCB_CALLBACK_HTTP: {
const lcb_RESPHTTP *htresp = (const lcb_RESPHTTP *)resp;
/* Store the CAS */
av_store(resobj, PLCB_HTIDX_STATUS, newSViv(htresp->htstatus));
if (htresp->headers) {
const char * const * hdr_cur;
HV *headers = newHV();
av_store(resobj, PLCB_HTIDX_HEADERS, newRV_noinc((SV*)headers));
for (hdr_cur = htresp->headers; *hdr_cur; hdr_cur += 2) {
const char *hdrkey = hdr_cur[0];
const char *hdrval = hdr_cur[1];
SV *valsv = newSVpv(hdrval, 0);
hv_store(headers, hdrkey, 0, valsv, 0);
}
}
if (htresp->nbody) {
lcb_U32 fmtflags = PLCB_CF_JSON;
SV *body;
SV *fmtspec = *av_fetch(resobj, PLCB_RETIDX_VALUE, 1);
if (SvIOK(fmtspec)) {
fmtflags = SvUV(fmtspec);
}
body = plcb_convert_retrieval_ex(parent, resobj,
htresp->body, htresp->nbody, fmtflags,
PLCB_CONVERT_NOCUSTOM);
av_store(resobj, PLCB_RETIDX_VALUE, body);
}
break;
}
default:
abort();
break;
}
ctx->nremaining--;
if (parent->async) {
call_async(ctx, resobj);
} else if (ctx->flags & PLCB_OPCTXf_WAITONE) {
av_push(ctx->u.ctxqueue, newRV_inc( (SV* )resobj));
plcb_kv_waitdone(parent);
}
if (!ctx->nremaining) {
SvREFCNT_dec(ctxrv);
plcb_kv_waitdone(parent);
plcb_opctx_clear(parent);
}
}
void perl_signal_args_to_c(
void (*callback)(void *, void **), void *cb_arg,
int signal_id, SV **args, size_t n_args)
{
union {
int v_int;
unsigned long v_ulong;
GSList *v_gslist;
GList *v_glist;
} saved_args[SIGNAL_MAX_ARGUMENTS];
void *p[SIGNAL_MAX_ARGUMENTS];
PERL_SIGNAL_ARGS_REC *rec;
size_t n;
if (!(rec = perl_signal_args_find(signal_id))) {
const char *name = signal_get_id_str(signal_id);
if (!name) {
croak("%d is not a known signal id", signal_id);
}
croak("\"%s\" is not a registered signal", name);
}
for (n = 0; n < SIGNAL_MAX_ARGUMENTS && n < n_args && rec->args[n] != NULL; ++n) {
void *c_arg;
SV *arg = args[n];
if (!SvOK(arg)) {
c_arg = NULL;
} else if (strcmp(rec->args[n], "string") == 0) {
c_arg = SvPV_nolen(arg);
} else if (strcmp(rec->args[n], "int") == 0) {
c_arg = (void *)SvIV(arg);
} else if (strcmp(rec->args[n], "ulongptr") == 0) {
saved_args[n].v_ulong = SvUV(arg);
c_arg = &saved_args[n].v_ulong;
} else if (strcmp(rec->args[n], "intptr") == 0) {
saved_args[n].v_int = SvIV(SvRV(arg));
c_arg = &saved_args[n].v_int;
} else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
GList *gl;
int is_str;
AV *av;
SV *t;
int count;
t = SvRV(arg);
if (SvTYPE(t) != SVt_PVAV) {
croak("Not an ARRAY reference");
}
av = (AV *)t;
is_str = strcmp(rec->args[n]+9, "char*") == 0;
gl = NULL;
count = av_len(av) + 1;
while (count-- > 0) {
SV **px = av_fetch(av, count, 0);
SV *x = px ? *px : NULL;
gl = g_list_prepend(
gl,
x == NULL ? NULL :
is_str ? g_strdup(SvPV_nolen(x)) :
irssi_ref_object(x)
);
}
saved_args[n].v_glist = gl;
c_arg = &saved_args[n].v_glist;
} else if (strncmp(rec->args[n], "gslist_", 7) == 0) {
GSList *gsl;
AV *av;
SV *t;
int count;
t = SvRV(arg);
if (SvTYPE(t) != SVt_PVAV) {
croak("Not an ARRAY reference");
}
av = (AV *)t;
gsl = NULL;
count = av_len(av) + 1;
while (count-- > 0) {
SV **x = av_fetch(av, count, 0);
gsl = g_slist_prepend(
gsl,
x == NULL ? NULL :
irssi_ref_object(*x)
);
}
c_arg = saved_args[n].v_gslist = gsl;
} else {
c_arg = irssi_ref_object(arg);
}
p[n] = c_arg;
}
for (; n < SIGNAL_MAX_ARGUMENTS; ++n) {
p[n] = NULL;
}
callback(cb_arg, p);
for (n = 0; n < SIGNAL_MAX_ARGUMENTS && n < n_args && rec->args[n] != NULL; ++n) {
SV *arg = args[n];
if (!SvOK(arg)) {
continue;
}
if (strcmp(rec->args[n], "intptr") == 0) {
SV *t = SvRV(arg);
SvIOK_only(t);
SvIV_set(t, saved_args[n].v_int);
} else if (strncmp(rec->args[n], "gslist_", 7) == 0) {
g_slist_free(saved_args[n].v_gslist);
} else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
int is_iobject, is_str;
AV *av;
GList *gl, *tmp;
is_iobject = strcmp(rec->args[n]+9, "iobject") == 0;
is_str = strcmp(rec->args[n]+9, "char*") == 0;
av = (AV *)SvRV(arg);
av_clear(av);
gl = saved_args[n].v_glist;
for (tmp = gl; tmp != NULL; tmp = tmp->next) {
av_push(av,
is_iobject ? iobject_bless((SERVER_REC *)tmp->data) :
is_str ? new_pv(tmp->data) :
irssi_bless_plain(rec->args[n]+9, tmp->data)
);
}
if (is_str) {
g_list_foreach(gl, (GFunc)g_free, NULL);
}
g_list_free(gl);
}
}
}
void
qrpng_internal (HV * options)
{
char * text;
unsigned text_length;
qr_t qr = {0};
qrpng_t qrpng = {0};
SV ** sv_ptr;
qrpng_status_t qrpng_status;
SV ** size_ptr;
/* Get the text. This is assumed to exist. */
HASH_FETCH_PV (options, text);
qr.input = text;
qr.input_length = text_length;
qr.level = 1;
sv_ptr = hv_fetch (options, "level", strlen ("level"), 0);
if (sv_ptr) {
qr.level = SvUV (* sv_ptr);
}
if (qr.level < 1 || qr.level > 4) {
croak ("Bad level %d; this is between 1 and 4", qr.level);
}
sv_ptr = hv_fetch (options, "version", strlen ("version"), 0);
if (sv_ptr) {
qr.version = SvUV (* sv_ptr);
if (qr.version < 1 || qr.version > 40) {
croak ("Bad version %d; this is between 1 and 40", qr.version);
}
initecc (& qr);
}
else {
initeccsize (& qr);
}
initframe(& qr);
qrencode (& qr);
sv_ptr = hv_fetch (options, "quiet", strlen ("quiet"), 0);
if (sv_ptr) {
SV * quiet_sv;
quiet_sv = * sv_ptr;
qrpng.quietzone = SvUV (quiet_sv);
}
else {
qrpng.quietzone = QUIETZONE;
}
sv_ptr = hv_fetch (options, "scale", strlen ("scale"), 0);
if (sv_ptr) {
SV * scale_sv;
scale_sv = * sv_ptr;
qrpng.scale = SvUV (scale_sv);
}
else {
qrpng.scale = 3;
}
qrpng_status = qrpng_make_png (& qr, & qrpng);
if (qrpng_status != qrpng_ok) {
croak ("bad status %d from qrpng_make_png", qrpng_status);
}
sv_ptr = hv_fetch (options, "out_sv", strlen ("out_sv"), 0);
if (sv_ptr) {
/* Write it as a scalar. The code is copied out of
Image::PNG::Libpng, but we don't depend on that. */
scalar_as_image_t si = {0};
png_set_write_fn (qrpng.png, & si, perl_png_scalar_write,
0 /* No flush function */);
/* Write using our function. */
png_write_png (qrpng.png, qrpng.info,
PNG_TRANSFORM_INVERT_MONO, NULL);
/* Put the data into %options as $options{png_data}. */
(void) hv_store (options, "png_data", strlen ("png_data"),
si.png_image, 0);
}
else {
char * out;
unsigned int out_length;
HASH_FETCH_PV (options, out);
qrpng.filename = out;
qrpng_write (& qrpng);
}
size_ptr = hv_fetch (options, "size", strlen ("size"), 0);
if (size_ptr) {
// fprintf (stderr, "%s:%d: OK baby.\n", __FILE__, __LINE__);
if (SvROK (* size_ptr) && SvTYPE (SvRV (* size_ptr)) < SVt_PVAV) {
SV * sv = SvRV (* size_ptr);
// fprintf (stderr, "%s:%d: OK baby.\n", __FILE__, __LINE__);
sv_setuv (sv, (UV) qrpng.img_size);
}
}
qrfree (& qr);
qrpng_free (& qrpng);
}
void
ffi_pl_closure_call(ffi_cif *ffi_cif, void *result, void **arguments, void *user)
{
dSP;
ffi_pl_closure *closure = (ffi_pl_closure*) user;
ffi_pl_type_extra_closure *extra = &closure->type->extra[0].closure;
int flags = extra->flags;
int i;
int count;
SV *sv;
SV **svp;
if(!(flags & G_NOARGS))
{
ENTER;
SAVETMPS;
}
PUSHMARK(SP);
if(!(flags & G_NOARGS))
{
for(i=0; i< ffi_cif->nargs; i++)
{
if(extra->argument_types[i]->platypus_type == FFI_PL_NATIVE)
{
switch(extra->argument_types[i]->ffi_type->type)
{
case FFI_TYPE_VOID:
break;
case FFI_TYPE_UINT8:
sv = sv_newmortal();
sv_setuv(sv, *((uint8_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_TYPE_SINT8:
sv = sv_newmortal();
sv_setiv(sv, *((int8_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_TYPE_UINT16:
sv = sv_newmortal();
sv_setuv(sv, *((uint16_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_TYPE_SINT16:
sv = sv_newmortal();
sv_setiv(sv, *((int16_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_TYPE_UINT32:
sv = sv_newmortal();
sv_setuv(sv, *((uint32_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_TYPE_SINT32:
sv = sv_newmortal();
sv_setiv(sv, *((int32_t*)arguments[i]));
XPUSHs(sv);
break;
case FFI_TYPE_UINT64:
sv = sv_newmortal();
#ifdef HAVE_IV_IS_64
sv_setuv(sv, *((uint64_t*)arguments[i]));
#else
sv_setu64(sv, *((uint64_t*)arguments[i]));
#endif
XPUSHs(sv);
break;
case FFI_TYPE_SINT64:
sv = sv_newmortal();
#ifdef HAVE_IV_IS_64
sv_setiv(sv, *((int64_t*)arguments[i]));
#else
sv_seti64(sv, *((int64_t*)arguments[i]));
#endif
XPUSHs(sv);
break;
case FFI_TYPE_FLOAT:
sv = sv_newmortal();
sv_setnv(sv, *((float*)arguments[i]));
XPUSHs(sv);
break;
case FFI_TYPE_DOUBLE:
sv = sv_newmortal();
sv_setnv(sv, *((double*)arguments[i]));
XPUSHs(sv);
break;
case FFI_TYPE_POINTER:
sv = sv_newmortal();
if( *((void**)arguments[i]) != NULL)
sv_setiv(sv, PTR2IV( *((void**)arguments[i]) ));
XPUSHs(sv);
break;
}
}
else if(extra->argument_types[i]->platypus_type == FFI_PL_STRING)
{
sv = sv_newmortal();
if( *((char**)arguments[i]) != NULL)
{
if(extra->argument_types[i]->extra[0].string.platypus_string_type == FFI_PL_STRING_FIXED)
sv_setpvn(sv, *((char**)arguments[i]), extra->argument_types[i]->extra[0].string.size);
else
sv_setpv(sv, *((char**)arguments[i]));
}
XPUSHs(sv);
}
}
PUTBACK;
}
svp = hv_fetch((HV *)SvRV((SV *)closure->coderef), "code", 4, 0);
if (svp)
count = call_sv(*svp, flags | G_EVAL);
else
count = 0;
if(SvTRUE(ERRSV))
{
#ifdef warn_sv
warn_sv(ERRSV);
#else
warn("%s", SvPV_nolen(ERRSV));
#endif
}
if(!(flags & G_DISCARD))
{
SPAGAIN;
if(count != 1)
sv = &PL_sv_undef;
else
sv = POPs;
if(extra->return_type->platypus_type == FFI_PL_NATIVE)
{
switch(extra->return_type->ffi_type->type)
{
case FFI_TYPE_UINT8:
#ifdef FFI_PL_PROBE_BIGENDIAN
((uint8_t*)result)[3] = SvUV(sv);
#else
*((uint8_t*)result) = SvUV(sv);
#endif
break;
case FFI_TYPE_SINT8:
#ifdef FFI_PL_PROBE_BIGENDIAN
((int8_t*)result)[3] = SvIV(sv);
#else
*((int8_t*)result) = SvIV(sv);
#endif
break;
case FFI_TYPE_UINT16:
#ifdef FFI_PL_PROBE_BIGENDIAN
((uint16_t*)result)[1] = SvUV(sv);
#else
*((uint16_t*)result) = SvUV(sv);
#endif
break;
case FFI_TYPE_SINT16:
#ifdef FFI_PL_PROBE_BIGENDIAN
((int16_t*)result)[1] = SvIV(sv);
#else
*((int16_t*)result) = SvIV(sv);
#endif
break;
case FFI_TYPE_UINT32:
*((uint32_t*)result) = SvUV(sv);
break;
case FFI_TYPE_SINT32:
*((int32_t*)result) = SvIV(sv);
break;
case FFI_TYPE_UINT64:
#ifdef HAVE_IV_IS_64
*((uint64_t*)result) = SvUV(sv);
#else
*((uint64_t*)result) = SvU64(sv);
#endif
break;
case FFI_TYPE_SINT64:
#ifdef HAVE_IV_IS_64
*((int64_t*)result) = SvIV(sv);
#else
*((int64_t*)result) = SvI64(sv);
#endif
break;
case FFI_TYPE_FLOAT:
*((float*)result) = SvNV(sv);
break;
case FFI_TYPE_DOUBLE:
*((double*)result) = SvNV(sv);
break;
case FFI_TYPE_POINTER:
*((void**)result) = SvOK(sv) ? INT2PTR(void*, SvIV(sv)) : NULL;
break;
}
}
PUTBACK;
}
