void operator()(SV **&sp, HashTable &result) {
EXTEND(sp, result.length() * 2);
for (HashTableIterator it = result.begin(); it != result.end(); ++it) {
PUSHs(String((*it).first).dispose());
PUSHs((*it).second);
}
}
static
int Print(csv_t* csv, SV* dst) {
int result;
if (csv->useIO) {
SV* tmp = newSVpv(csv->buffer, csv->used);
dSP;
PUSHMARK(sp);
EXTEND(sp, 2);
PUSHs((dst));
PUSHs(tmp);
PUTBACK;
result = perl_call_method("print", G_SCALAR);
SPAGAIN;
if (result) {
result = POPi;
}
PUTBACK;
SvREFCNT_dec(tmp);
} else {
sv_catpvn(SvRV(dst), csv->buffer, csv->used);
result = TRUE;
}
csv->used = 0;
return result;
}
/* this is public so that other extensions which use GtkMenuPosFunc (e.g.
* libgnomeui) don't need to reimplement it. */
void
gtk2perl_menu_position_func (GtkMenu * menu,
gint * x,
gint * y,
gboolean * push_in,
GPerlCallback * callback)
{
int n;
dGPERL_CALLBACK_MARSHAL_SP;
GPERL_CALLBACK_MARSHAL_INIT (callback);
ENTER;
SAVETMPS;
PUSHMARK (SP);
EXTEND (SP, 3);
PUSHs (sv_2mortal (newSVGtkMenu (menu)));
PUSHs (sv_2mortal (newSViv (*x)));
PUSHs (sv_2mortal (newSViv (*y)));
if (callback->data)
XPUSHs (sv_2mortal (newSVsv (callback->data)));
/* A die() from callback->func is suspected to be bad or very bad.
Circa Gtk 2.18 a jump out of $menu->popup seems to leave an X
grab with no way to get rid of it (no keyboard Esc, and no mouse
click handlers). The position func can also be called later for
things like resizing or move to a different GdkScreen, and such a
call might come straight from the main loop, where a die() would
jump out of Gtk2->main. */
PUTBACK;
n = call_sv (callback->func, G_ARRAY | G_EVAL);
SPAGAIN;
if (SvTRUE (ERRSV)) {
g_warning ("menu position callback ignoring error: %s",
SvPVutf8_nolen (ERRSV));
} else if (n < 2 || n > 3) {
g_warning ("menu position callback must return two integers "
"(x, and y) or two integers and a boolean "
"(x, y, and push_in)");
} else {
/* POPs and POPi take things off the *end* of the stack! */
if (n > 2) {
SV *sv = POPs;
*push_in = sv_2bool (sv);
}
if (n > 1) *y = POPi;
if (n > 0) *x = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
}
static int CsvGet(csv_t* csv, SV* src) {
if (!csv->useIO) {
return EOF;
}
{
int result;
dSP;
PUSHMARK(sp);
EXTEND(sp, 1);
PUSHs(src);
PUTBACK;
result = perl_call_method("getline", G_SCALAR);
SPAGAIN;
if (result) {
csv->tmp = POPs;
} else {
csv->tmp = NULL;
}
PUTBACK;
}
if (csv->tmp && SvOK(csv->tmp)) {
csv->bptr = SvPV(csv->tmp, csv->size);
csv->used = 0;
if (csv->size) {
return ((unsigned char) csv->bptr[csv->used++]);
}
}
return EOF;
}
static void plcb_call_sv_with_args_noret(SV *code, int mortalize, int nargs, ...)
{
va_list ap;
SV *cursv;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
EXTEND(SP, nargs);
va_start(ap, nargs);
while (nargs) {
cursv = va_arg(ap, SV*);
if (mortalize) {
cursv = sv_2mortal(cursv);
}
PUSHs(cursv);
nargs--;
}
va_end(ap);
PUTBACK;
call_sv(code, G_DISCARD);
FREETMPS;
LEAVE;
}
static inline void do_check(SV *cv, SV *value, SV *key) {
dTHX;
SV *ok = &PL_sv_undef, *msg = &PL_sv_undef;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
PUSHs(sv_mortalcopy(value));
PUTBACK;
int count = call_sv(cv, G_ARRAY);
// could return 0 or 1 or 2 or more
SPAGAIN;
if (count) count == 1 ? (ok = POPs) : (msg = POPs, ok = POPs);
if (!SvTRUE(ok)) {
croak("Bad value \"%s\" for attribute \"%s\": %s", SvPV_nolen(value),
SvPV_nolen(key), SvTRUE(msg) ? SvPV_nolen(msg) : "");
}
PUTBACK;
FREETMPS;
LEAVE;
};
void
Perl_av_extend(pTHX_ AV *av, I32 key)
{
MAGIC *mg;
if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
dSP;
ENTER;
SAVETMPS;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP,2);
PUSHs(SvTIED_obj((SV*)av, mg));
PUSHs(sv_2mortal(newSViv(key+1)));
PUTBACK;
call_method("EXTEND", G_SCALAR|G_DISCARD);
POPSTACK;
FREETMPS;
LEAVE;
return;
}
if (key > AvMAX(av)) {
SV** ary;
I32 tmp;
I32 newmax;
if (AvALLOC(av) != AvARRAY(av)) {
ary = AvALLOC(av) + AvFILLp(av) + 1;
tmp = AvARRAY(av) - AvALLOC(av);
Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
AvMAX(av) += tmp;
SvPVX(av) = (char*)AvALLOC(av);
if (AvREAL(av)) {
while (tmp)
ary[--tmp] = &PL_sv_undef;
}
if (key > AvMAX(av) - 10) {
newmax = key + AvMAX(av);
goto resize;
}
}
lucy_Err*
lucy_Err_trap(Cfish_Err_Attempt_t routine, void *context) {
lucy_Err *error = NULL;
SV *routine_sv = newSViv(PTR2IV(routine));
SV *context_sv = newSViv(PTR2IV(context));
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
EXTEND(SP, 2);
PUSHs(sv_2mortal(routine_sv));
PUSHs(sv_2mortal(context_sv));
PUTBACK;
int count = call_sv(attempt_xsub, G_EVAL | G_DISCARD);
if (count != 0) {
lucy_CharBuf *mess
= lucy_CB_newf("'attempt' returned too many values: %i32",
(int32_t)count);
error = lucy_Err_new(mess);
}
else {
SV *dollar_at = get_sv("@", FALSE);
if (SvTRUE(dollar_at)) {
if (sv_isobject(dollar_at)
&& sv_derived_from(dollar_at,"Clownfish::Err")
) {
IV error_iv = SvIV(SvRV(dollar_at));
error = INT2PTR(lucy_Err*, error_iv);
CFISH_INCREF(error);
}
else {
STRLEN len;
char *ptr = SvPVutf8(dollar_at, len);
lucy_CharBuf *mess = lucy_CB_new_from_trusted_utf8(ptr, len);
error = lucy_Err_new(mess);
}
}
int
c2p_fetchcb(const char * url, const char * dest, int force)
{
SV * svret;
int ret;
dSP;
if(!fetchcb_ref){
return -1;
}
ENTER;
SAVETMPS;
PUSHMARK(SP);
EXTEND(SP, 3);
PUSHs(sv_2mortal(newSVpv(url, 0)));
PUSHs(sv_2mortal(newSVpv(dest, 0)));
PUSHs(sv_2mortal(newSViv(force)));
PUTBACK;
ret = 0;
if(call_sv(fetchcb_ref, G_SCALAR | G_EVAL) == 1){
svret = POPs;
if(SvTRUE(ERRSV)){
/* the callback died, return an error to libalpm */
ret = -1;
}else{
ret = (SvTRUE(svret) ? 1 : 0);
}
}
FREETMPS;
LEAVE;
return ret;
}
static void _MopMmV_wrapper (pTHX_ CV *cv) {
bool has_events;
I32 j, count;
SV** args;
CV* body;
SV* object = newRV_noinc((SV*) cv);
AV* results = newAV();
dXSARGS;
has_events = MopOV_has_events(object);
body = (CV*) CvXSUBANY(cv).any_uv;
if (has_events) {
Newx(args, items, SV*);
for (j = 0; j < items; j++) {
args[j] = ST(j);
}
MopOV_fire_event(object, newSVpv("before:EXECUTE", 14), args, items-1);
}
{
ENTER;
PUSHMARK(SP);
for (j = 0; j < items; j++) {
PUSHs(args[j]);
}
PUTBACK;
count = call_sv((SV*) body, GIMME_V);
SPAGAIN;
while (count-- > 0) {
av_push(results, POPs);
}
LEAVE;
}
for (j = 0; j < av_len(results) + 1; j++) {
ST(j) = *av_fetch(results, av_len(results) - j, 0);
}
if (has_events) {
MopOV_fire_event(object, newSVpv("after:EXECUTE", 13), args, items-1);
}
XSRETURN(av_len(results) + 1);
}
void
Perl_av_extend(pTHX_ AV *av, I32 key)
{
dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_AV_EXTEND;
assert(SvTYPE(av) == SVt_PVAV);
mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied);
if (mg) {
dSP;
ENTER;
SAVETMPS;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP,2);
PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
mPUSHi(key + 1);
PUTBACK;
call_method("EXTEND", G_SCALAR|G_DISCARD);
POPSTACK;
FREETMPS;
LEAVE;
return;
}
if (key > AvMAX(av)) {
SV** ary;
I32 tmp;
I32 newmax;
if (AvALLOC(av) != AvARRAY(av)) {
ary = AvALLOC(av) + AvFILLp(av) + 1;
tmp = AvARRAY(av) - AvALLOC(av);
Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
AvMAX(av) += tmp;
AvARRAY(av) = AvALLOC(av);
if (AvREAL(av)) {
while (tmp)
ary[--tmp] = &PL_sv_undef;
}
if (key > AvMAX(av) - 10) {
newmax = key + AvMAX(av);
goto resize;
}
}
void
c2p_totaldlcb(off_t total)
{
dSP;
if(!totaldlcb_ref){
return;
}
ENTER;
SAVETMPS;
PUSHMARK(SP);
EXTEND(SP, 1);
PUSHs(sv_2mortal(newSViv(total)));
PUTBACK;
call_sv(totaldlcb_ref, G_DISCARD);
FREETMPS;
LEAVE;
return;
}
// invoce cv, passing arg, store result of that invocation to hash, return an SV
// from HeVAL
static inline SV *invoke_and_store(SV *arg, SV *cv, HV *hash, SV *key) {
dTHX;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
PUSHs(sv_mortalcopy(arg));
PUTBACK;
int count = call_sv(cv, G_SCALAR);
if (count != 1) croak("bad count");
SPAGAIN;
SV *tmp = POPs;
SV *result = hv_he_store_or_croak(hash, key, tmp);
PUTBACK;
FREETMPS;
LEAVE;
return result;
}
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;
}
static ngx_int_t
ngx_http_perl_call_handler(pTHX_ ngx_http_request_t *r, HV *nginx, SV *sub,
SV **args, ngx_str_t *handler, ngx_str_t *rv)
{
SV *sv;
int n, status;
char *line;
STRLEN len, n_a;
ngx_str_t err;
ngx_uint_t i;
ngx_connection_t *c;
dSP;
status = 0;
ENTER;
SAVETMPS;
PUSHMARK(sp);
sv = sv_2mortal(sv_bless(newRV_noinc(newSViv(PTR2IV(r))), nginx));
XPUSHs(sv);
if (args) {
EXTEND(sp, (intptr_t) args[0]);
for (i = 1; i <= (ngx_uint_t) args[0]; i++) {
PUSHs(sv_2mortal(args[i]));
}
}
PUTBACK;
c = r->connection;
n = call_sv(sub, G_EVAL);
SPAGAIN;
if (c->destroyed) {
PUTBACK;
FREETMPS;
LEAVE;
return NGX_DONE;
}
if (n) {
if (rv == NULL) {
status = POPi;
ngx_log_debug1(NGX_LOG_DEBUG_HTTP, c->log, 0,
"call_sv: %d", status);
} else {
line = SvPVx(POPs, n_a);
rv->len = n_a;
rv->data = ngx_pnalloc(r->pool, n_a);
if (rv->data == NULL) {
return NGX_ERROR;
}
ngx_memcpy(rv->data, line, n_a);
}
}
PUTBACK;
FREETMPS;
LEAVE;
/* check $@ */
if (SvTRUE(ERRSV)) {
err.data = (u_char *) SvPV(ERRSV, len);
for (len--; err.data[len] == LF || err.data[len] == CR; len--) {
/* void */
}
err.len = len + 1;
ngx_log_error(NGX_LOG_ERR, c->log, 0,
"call_sv(\"%V\") failed: \"%V\"", handler, &err);
if (rv) {
return NGX_ERROR;
}
return NGX_HTTP_INTERNAL_SERVER_ERROR;
}
if (n != 1) {
ngx_log_error(NGX_LOG_ALERT, c->log, 0,
"call_sv(\"%V\") returned %d results", handler, n);
status = NGX_OK;
}
if (rv) {
return NGX_OK;
}
return (ngx_int_t) status;
}
void operator()(SV **&sp, String &result) {
EXTEND(sp, 1);
PUSHs(sv_2mortal(result.dispose()));
}
void operator()(SV **&sp, Reference &result) {
EXTEND(sp, 1);
PUSHs(sv_2mortal(result.dispose()));
}
// Convert all arguments to Perl and place them on the Perl stack.
static CHY_INLINE void
SI_push_args(void *vobj, va_list args, uint32_t num_args)
{
kino_Obj *obj = (kino_Obj*)vobj;
SV *invoker;
uint32_t i;
dSP;
uint32_t stack_slots_needed = num_args < 2
? num_args + 1
: (num_args * 2) + 1;
EXTEND(SP, stack_slots_needed);
if (Kino_Obj_Is_A(obj, KINO_VTABLE)) {
kino_VTable *vtable = (kino_VTable*)obj;
// TODO: Creating a new class name SV every time is wasteful.
invoker = XSBind_cb_to_sv(Kino_VTable_Get_Name(vtable));
}
else {
invoker = (SV*)Kino_Obj_To_Host(obj);
}
ENTER;
SAVETMPS;
PUSHMARK(SP);
PUSHs( sv_2mortal(invoker) );
for (i = 0; i < num_args; i++) {
uint32_t arg_type = va_arg(args, uint32_t);
char *label = va_arg(args, char*);
if (num_args > 1) {
PUSHs( sv_2mortal( newSVpvn(label, strlen(label)) ) );
}
switch (arg_type & CFISH_HOST_ARGTYPE_MASK) {
case CFISH_HOST_ARGTYPE_I32: {
int32_t value = va_arg(args, int32_t);
PUSHs( sv_2mortal( newSViv(value) ) );
}
break;
case CFISH_HOST_ARGTYPE_I64: {
int64_t value = va_arg(args, int64_t);
if (sizeof(IV) == 8) {
PUSHs( sv_2mortal( newSViv((IV)value) ) );
}
else {
// lossy
PUSHs( sv_2mortal( newSVnv((double)value) ) );
}
}
break;
case CFISH_HOST_ARGTYPE_F32:
case CFISH_HOST_ARGTYPE_F64: {
// Floats are promoted to doubles by variadic calling.
double value = va_arg(args, double);
PUSHs( sv_2mortal( newSVnv(value) ) );
}
break;
case CFISH_HOST_ARGTYPE_STR: {
kino_CharBuf *string = va_arg(args, kino_CharBuf*);
PUSHs( sv_2mortal( XSBind_cb_to_sv(string) ) );
}
break;
case CFISH_HOST_ARGTYPE_OBJ: {
kino_Obj* anObj = va_arg(args, kino_Obj*);
SV *arg_sv = anObj == NULL
? newSV(0)
: XSBind_cfish_to_perl(anObj);
PUSHs( sv_2mortal(arg_sv) );
}
break;
default:
CFISH_THROW(KINO_ERR, "Unrecognized arg type: %u32", arg_type);
}
}
PUTBACK;
}
static void* run_thread(void* arg) {
mthread* thread = (mthread*) arg;
PerlInterpreter* my_perl = construct_perl();
const message *to_run, *modules, *message;
SV *call, *status;
perl_mutex* shutdown_mutex;
thread->interp = my_perl;
#ifndef WIN32
S_set_sigmask(&thread->initial_sigmask);
#endif
PERL_SET_CONTEXT(my_perl);
store_self(my_perl, thread);
{
dSP;
modules = queue_dequeue(thread->queue, NULL);
load_modules(my_perl, modules);
to_run = queue_dequeue(thread->queue, NULL);
ENTER;
SAVETMPS;
call = SvRV(message_load_value(to_run));
PUSHMARK(SP);
mXPUSHs(newSVpvn("exit", 4));
status = newSVpvn("normal", 6);
mXPUSHs(status);
mXPUSHs(newSViv(thread->id));
ENTER;
PUSHMARK(SP);
PUTBACK;
call_sv(call, G_SCALAR|G_EVAL);
SPAGAIN;
if (SvTRUE(ERRSV)) {
sv_setpvn(status, "error", 5);
warn("Thread %"UVuf" got error %s\n", thread->id, SvPV_nolen(ERRSV));
PUSHs(ERRSV);
}
message_from_stack_pushed(message);
LEAVE;
send_listeners(thread, message);
destroy_message(message);
FREETMPS;
LEAVE;
}
shutdown_mutex = get_shutdown_mutex();
MUTEX_LOCK(shutdown_mutex);
perl_destruct(my_perl);
MUTEX_UNLOCK(shutdown_mutex);
mthread_destroy(thread);
PerlMemShared_free(thread);
perl_free(my_perl);
return NULL;
}
void operator()(SV **&sp, Array &result) {
EXTEND(sp, result.length());
for (ArrayIterator it = result.begin(); it != result.end(); ++it) {
PUSHs(*it);
}
}
