C++ SvTRUE函数代码示例

static int output_body_path(request_rec *r, SV *body)
{
    dTHX;
    int count;
    apr_status_t rc;
    SV *path_sv;
    char *path = NULL;
    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK(SP);
    XPUSHs(body);
    PUTBACK;

    count = call_method("path", G_EVAL|G_SCALAR|G_KEEPERR);
    SPAGAIN;
    if (SvTRUE(ERRSV)) {
        rc = DECLINED;
        server_error(r, "unable to get path\n%s", SvPV_nolen(ERRSV));
        CLEAR_ERRSV();
        (void) POPs;
    } else if (count > 0) {
        path_sv = POPs;
        path = apr_pstrdup(r->pool, SvPV_nolen(path_sv));
        rc = OK;
    } else {
        rc = DECLINED;
    }
    PUTBACK;
    FREETMPS;
    LEAVE;

    return rc != OK ? rc : output_body_sendfile(r, path);
}

static ngx_int_t
ngx_http_perl_run_requires(pTHX_ ngx_array_t *requires, ngx_log_t *log)
{
    char       **script;
    STRLEN       len;
    ngx_str_t    err;
    ngx_uint_t   i;

    script = requires->elts;
    for (i = 0; i < requires->nelts; i++) {

        require_pv(script[i]);

        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_EMERG, log, 0,
                          "require_pv(\"%s\") failed: \"%V\"", script[i], &err);

            return NGX_ERROR;
        }
    }

    return NGX_OK;
}

static html_valid_status_t
html_valid_set_option (html_valid_t * htv, SV * option, SV * value)
{
    TidyOption to;
    TidyOptionType tot;
    TidyOptionId ti;
    const char * coption;
    STRLEN coption_length;
    CHECK_INIT (htv);
    coption = SvPV (option, coption_length);
    to = tidyGetOptionByName(htv->tdoc, coption);
    if (to == 0) {
	warn ("unknown option %s", coption);
	return html_valid_unknown_option;
    }
    ti = tidyOptGetId (to);
    tot = tidyOptGetType (to);
    switch (tot) {
    case TidyString:
	CALL (set_string_option (htv, coption, ti, value));
	break;
    case TidyInteger:
	CALL (set_number_option (htv, coption, ti, value));
	break;
    case TidyBoolean:
	tidyOptSetBool (htv->tdoc, ti, SvTRUE (value));
	break;
    default:
	fprintf (stderr, "%s:%d: bad option type %d from tidy library.\n",
		 __FILE__, __LINE__, tot);
	return html_valid_bad_option_type;
    }
    return html_valid_ok;
}

static SV *coroae_condvar_new() {
	
	SV *newobj;

        dSP;

        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
        XPUSHs(sv_2mortal(newSVpv( "AnyEvent", 8)));
        PUTBACK;

        call_method( "condvar", G_SCALAR);

        SPAGAIN;
        if(SvTRUE(ERRSV)) {
                uwsgi_log("[uwsgi-perl error] %s", SvPV_nolen(ERRSV));
                newobj = NULL;
        }
        else {
                newobj = SvREFCNT_inc(POPs);
        }
        PUTBACK;
        FREETMPS;
        LEAVE;

        return newobj;
}

static bool do_script_list(sourceinfo_t *si)
{
	bool retval = true;

	dSP;
	ENTER;

	SAVETMPS;
	PUSHMARK(SP);

	SV *arg = newSV(0);
	sv_setref_pv(arg, "Atheme::Sourceinfo", si);
	XPUSHs(sv_2mortal(arg));
	PUTBACK;

	call_pv("Atheme::Init::list_scripts", G_EVAL | G_DISCARD);

	SPAGAIN;

	if (SvTRUE(ERRSV))
	{
		retval = false;
		mowgli_strlcpy(perl_error, SvPV_nolen(ERRSV), sizeof(perl_error));
		POPs;
	}

	FREETMPS;
	LEAVE;

	invalidate_object_references();

	return retval;
}

static inline void
do_script_hook_pre_format_html(unsigned char *url, struct cache_entry *cached,
			       struct fragment *fragment)
{
	int count;
	dSP;	/* Keep in variables declaration block. */

	ENTER;
	SAVETMPS;

	PUSHMARK(SP);
	my_XPUSHs(url, strlen((const char *)url));
	my_XPUSHs(fragment->data, fragment->length);
	PUTBACK;

	count = call_pv("pre_format_html_hook", G_EVAL | G_SCALAR);
	if (SvTRUE(ERRSV)) count = 0;	/* FIXME: error message ? */
	SPAGAIN;
	if (count == 1) {
		SV *new_html_sv = POPs;
		STRLEN new_html_len;
		unsigned char *new_html = SvPV(new_html_sv, new_html_len);

		if (new_html) {
			add_fragment(cached, 0, new_html, new_html_len);
			normalize_cache_entry(cached, new_html_len);
		}
	}

	PUTBACK;
	FREETMPS;
	LEAVE;
}

static inline void
do_script_hook_follow_url(unsigned char **url)
{
	int count;
	dSP;	/* Keep in variables declaration block. */

	ENTER;
	SAVETMPS;

	PUSHMARK(SP);
	my_XPUSHs(*url, strlen((const char *)*url));
	PUTBACK;

	count = call_pv("follow_url_hook", G_EVAL | G_SCALAR);
	if (SvTRUE(ERRSV)) count = 0;	/* FIXME: error message ? */
	SPAGAIN;
	if (count == 1) {
#ifndef CONFIG_PERL_POPPX_WITHOUT_N_A
		STRLEN n_a;	/* Used by POPpx macro. */
#endif
		unsigned char *new_url = POPpx;

		if (new_url) {
			unsigned char *n = stracpy(new_url);

			if (n) {
				mem_free_set(url, n);
			}
		}
	}

	PUTBACK;
	FREETMPS;
	LEAVE;
}

void owl_perlconfig_edit_callback(owl_editwin *e)
{
  SV *cb = owl_editwin_get_cbdata(e);
  SV *text;
  dSP;

  if(cb == NULL) {
    owl_function_error("Perl callback is NULL!");
    return;
  }
  text = owl_new_sv(owl_editwin_get_text(e));

  ENTER;
  SAVETMPS;

  PUSHMARK(SP);
  XPUSHs(sv_2mortal(text));
  PUTBACK;
  
  call_sv(cb, G_DISCARD|G_EVAL);

  if(SvTRUE(ERRSV)) {
    owl_function_error("%s", SvPV_nolen(ERRSV));
  }

  FREETMPS;
  LEAVE;
}

void owl_perlconfig_perl_timer(owl_timer *t, void *data)
{
  dSP;
  SV *obj = data;

  if(!SvROK(obj)) {
    return;
  }

  ENTER;
  SAVETMPS;

  PUSHMARK(SP);
  XPUSHs(obj);
  PUTBACK;

  call_method("do_callback", G_DISCARD|G_EVAL);

  SPAGAIN;

  if (SvTRUE(ERRSV)) {
    owl_function_error("Error in callback: '%s'", SvPV_nolen(ERRSV));
    sv_setsv (ERRSV, &PL_sv_undef);
  }

  PUTBACK;
  FREETMPS;
  LEAVE;
}

int modperl_require_module(pTHX_ const char *pv, int logfailure)
{
    SV *sv;

    dSP;
    PUSHSTACKi(PERLSI_REQUIRE);
    ENTER;SAVETMPS;
    PUTBACK;
    sv = sv_newmortal();
    sv_setpv(sv, "require ");
    sv_catpv(sv, pv);
    eval_sv(sv, G_DISCARD);
    SPAGAIN;
    POPSTACK;
    FREETMPS;LEAVE;

    if (SvTRUE(ERRSV)) {
        if (logfailure) {
            (void)modperl_errsv(aTHX_ HTTP_INTERNAL_SERVER_ERROR,
                                NULL, NULL);
        }
        return FALSE;
    }

    return TRUE;
}

int modperl_errsv(pTHX_ int status, request_rec *r, server_rec *s)
{
    SV *sv = ERRSV;
    STRLEN n_a;

    if (SvTRUE(sv)) {
        if (sv_derived_from(sv, "APR::Error") &&
            SvIVx(sv) == MODPERL_RC_EXIT) {
            /* ModPerl::Util::exit was called */
            return OK;
        }
#if 0
        if (modperl_sv_is_http_code(ERRSV, &status)) {
            return status;
        }
#endif
        if (r) {
            ap_log_rerror(APLOG_MARK, APLOG_ERR, 0, r, "%s", SvPV(sv, n_a));
        }
        else {
            ap_log_error(APLOG_MARK, APLOG_ERR, 0, s, "%s", SvPV(sv, n_a));
        }

        return status;
    }

    return status;
}

	virtual EModRet OnModuleLoading(const CString& sModName, const CString& sArgs,
			bool& bSuccess, CString& sRetMsg) {
		if (!GetUser()) {
			return CONTINUE;
		}
		EModRet result = HALT;
		PSTART;
		PUSH_STR(sModName);
		PUSH_STR(sArgs);
		PUSH_PTR(CUser*, GetUser());
		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;
	}

/*
 * The xlat function
 */
static ssize_t perl_xlat(void *instance, REQUEST *request, char const *fmt, char *out, size_t freespace)
{

	rlm_perl_t	*inst = (rlm_perl_t *) instance;
	char		*tmp;
	char const	*p, *q;
	int		count;
	size_t		ret = 0;
	STRLEN		n_a;

#ifdef USE_ITHREADS
	PerlInterpreter *interp;

	pthread_mutex_lock(&inst->clone_mutex);
	interp = rlm_perl_clone(inst->perl, inst->thread_key);
	{
		dTHXa(interp);
		PERL_SET_CONTEXT(interp);
	}
	pthread_mutex_unlock(&inst->clone_mutex);
#else
	PERL_SET_CONTEXT(inst->perl);
#endif
	{
		dSP;
		ENTER;SAVETMPS;

		PUSHMARK(SP);

		p = fmt;
		while ((q = strchr(p, ' '))) {
			XPUSHs(sv_2mortal(newSVpvn(p, p - q)));

			p = q + 1;
		}

		PUTBACK;

		count = call_pv(inst->func_xlat, G_SCALAR | G_EVAL);

		SPAGAIN;
		if (SvTRUE(ERRSV)) {
			REDEBUG("Exit %s", SvPV(ERRSV,n_a));
			(void)POPs;
		} else if (count > 0) {
			tmp = POPp;
			strlcpy(out, tmp, freespace);
			ret = strlen(out);

			RDEBUG("Len is %zu , out is %s freespace is %zu", ret, out, freespace);
		}

		PUTBACK ;
		FREETMPS ;
		LEAVE ;

	}

	return ret;
}

static int perl_timeout(PERL_TIMEOUT_REC *rec)
{
	dSP;
	int retcount;

	ENTER;
	SAVETMPS;

	PUSHMARK(SP);
	XPUSHs(sv_2mortal(newSVpv(rec->data, strlen(rec->data))));
	PUTBACK;

	retcount = perl_call_pv(rec->func, G_EVAL|G_SCALAR);
	SPAGAIN;

	if (SvTRUE(ERRSV)) {
		STRLEN n_a;

		signal_emit("perl error", 1, SvPV(ERRSV, n_a));
		(void) POPs;
	}
	else while (retcount--) (void) POPi;

	PUTBACK;
	FREETMPS;
	LEAVE;

	return 1;
}

static void
perl_pref_cb(const char *name, PurplePrefType type, gconstpointer value,
			 gpointer data)
{
	PurplePerlPrefsHandler *handler = data;

	dSP;
	ENTER;
	SAVETMPS;
	PUSHMARK(sp);
	XPUSHs(sv_2mortal(newSVpv(name, 0)));

	XPUSHs(sv_2mortal(newSViv(type)));

	switch(type) {
		case PURPLE_PREF_INT:
			XPUSHs(sv_2mortal(newSViv(GPOINTER_TO_INT(value))));
			break;
		case PURPLE_PREF_BOOLEAN:
			XPUSHs((GPOINTER_TO_INT(value) == FALSE) ? &PL_sv_no : &PL_sv_yes);
			break;
		case PURPLE_PREF_STRING:
		case PURPLE_PREF_PATH:
			XPUSHs(sv_2mortal(newSVGChar(value)));
			break;
		case PURPLE_PREF_STRING_LIST:
		case PURPLE_PREF_PATH_LIST:
			{
				AV* av = newAV();
				const GList *l = value;

				/* Append stuff backward to preserve order */
				while (l && l->next) l = l->next;
				while (l) {
					av_push(av, sv_2mortal(newSVGChar(l->data)));
					l = l->prev;
				}
				XPUSHs(sv_2mortal(newRV_noinc((SV *) av)));
			} break;
		default:
		case PURPLE_PREF_NONE:
			XPUSHs(&PL_sv_undef);
			break;
	}

	XPUSHs((SV *)handler->data);
	PUTBACK;
	call_sv(handler->callback, G_EVAL | G_VOID | G_DISCARD);
	SPAGAIN;

	if (SvTRUE(ERRSV)) {
		purple_debug_error("perl",
		                 "Perl prefs callback function exited abnormally: %s\n",
		                 SvPVutf8_nolen(ERRSV));
	}

	PUTBACK;
	FREETMPS;
	LEAVE;
}