Esempio n. 1
0
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;
}
Esempio n. 2
0
SV *
callFilter(SV *filter, SV *el)
{
  SV *val;
  I32 n;

 dTHX;
 dSP;
 ENTER;
 SAVETMPS;
 PUSHMARK(sp);

  XPUSHs(el);
  PUTBACK;
  n = call_sv(filter, (G_SCALAR | G_EVAL));
  SPAGAIN;
  val = POPs;
  SvREFCNT_inc(val);

 PUTBACK;
 FREETMPS;
 LEAVE;

   return(val);
}
Esempio n. 3
0
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;
}
Esempio n. 4
0
static SV *run_app(request_rec *r, SV *app, SV *env)
{
    dTHX;
    int count;
    SV *res;
    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK(SP) ;
    XPUSHs(sv_2mortal(env));
    PUTBACK;

    count = call_sv(app, G_EVAL|G_SCALAR|G_KEEPERR);
    SPAGAIN;
    if (SvTRUE(ERRSV)) {
        res = NULL;
        server_error(r, "%s", SvPV_nolen(ERRSV));
        CLEAR_ERRSV();
        (void) POPs;
    } else if (count > 0) {
        res = POPs;
        SvREFCNT_inc(res);
    } else {
        res = NULL;
    }
    PUTBACK;
    FREETMPS;
    LEAVE;
    return res;
}
Esempio n. 5
0
void _installsrpms(rpmts ts, char * filename) {
    const char * specfile = NULL;
    const char * cookies = NULL;
    dSP;
    I32 gimme = GIMME_V;
    if (rpmInstallSource(
                ts,
                filename,
                &specfile,
                &cookies) == 0) {
        XPUSHs(sv_2mortal(newSVpv(specfile, 0)));
        if (gimme == G_ARRAY)
            XPUSHs(sv_2mortal(newSVpv(cookies, 0)));
    }
    PUTBACK;
}
Esempio n. 6
0
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);
}
Esempio n. 7
0
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;
}
Esempio n. 8
0
bool EQWParser::dosub(const char * subname, const std::vector<std::string> &args, std::string &error, int mode) {
	bool err = false;
	dSP;				// initialize stack pointer
	ENTER;				// everything created after here
	SAVETMPS;			// ...is a temporary variable
	PUSHMARK(SP);		// remember the stack pointer
	if(args.size() > 0)
	{
		for(std::vector<std::string>::const_iterator i = args.begin(); i != args.end(); ++i)
		{/* push the arguments onto the perl stack */
			XPUSHs(sv_2mortal(newSVpv(i->c_str(), i->length())));
		}
	}
	PUTBACK;					// make local stack pointer global
	call_pv(subname, mode);		/*eval our code*/
	SPAGAIN;					// refresh stack pointer
	if(SvTRUE(ERRSV)) {
		err = true;
	}
	FREETMPS;		// free temp values
	LEAVE;			// ...and the XPUSHed "mortal" args.

	if(err) {
		error = "Perl runtime error: ";
		error += SvPVX(ERRSV);
		return(false);
	}
	return(true);
}
Esempio n. 9
0
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;
}
Esempio n. 10
0
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;
}
Esempio n. 11
0
static
XS (XS_Xchat_unhook)
{
	xchat_hook *hook;
	HookData *userdata;
	int retCount = 0;
	dXSARGS;
	if (items != 1) {
		xchat_print (ph, "Usage: Xchat::unhook(hook)");
	} else {
		hook = INT2PTR (xchat_hook *, SvUV (ST (0)));
		userdata = (HookData *) xchat_unhook (ph, hook);

		if (userdata != NULL) {
			if (userdata->callback != NULL) {
				SvREFCNT_dec (userdata->callback);
			}

			if (userdata->userdata != NULL) {
				XPUSHs (sv_mortalcopy (userdata->userdata));
				SvREFCNT_dec (userdata->userdata);
				retCount = 1;
			}

			if (userdata->package != NULL) {
				SvREFCNT_dec (userdata->package);
			}
			free (userdata);
		}
		XSRETURN (retCount);
	}
	XSRETURN_EMPTY;
}
Esempio n. 12
0
/*
 * 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;
}
Esempio n. 13
0
static
XS (XS_Xchat_get_info)
{
	SV *temp = NULL;
	dXSARGS;
	if (items != 1) {
		xchat_print (ph, "Usage: Xchat::get_info(id)");
	} else {
		SV *id = ST (0);
		const char *RETVAL;

		RETVAL = xchat_get_info (ph, SvPV_nolen (id));
		if (RETVAL == NULL) {
			XSRETURN_UNDEF;
		}

		if (!strncmp ("win_ptr", SvPV_nolen (id), 7)) {
			XSRETURN_IV (PTR2IV (RETVAL));
		} else {
			
			if (
				!strncmp ("libdirfs", SvPV_nolen (id), 8) ||
				!strncmp ("xchatdirfs", SvPV_nolen (id), 10)
			) {
				XSRETURN_PV (RETVAL);
			} else {
				temp = newSVpv (RETVAL, 0);
				SvUTF8_on (temp);
				PUSHMARK (SP);
				XPUSHs (sv_2mortal (temp));
				PUTBACK;
			}
		}
	}
}
Esempio n. 14
0
/*
  this is used for autoload and shutdown callbacks
*/
static int
execute_perl (SV * function, char *args)
{

	int count, ret_value = 1;

	dSP;
	ENTER;
	SAVETMPS;

	PUSHMARK (SP);
	XPUSHs (sv_2mortal (newSVpv (args, 0)));
	PUTBACK;

	count = call_sv (function, G_EVAL | G_SCALAR);
	SPAGAIN;

	if (SvTRUE (ERRSV)) {
		/*STRLEN n_a;
		xchat_printf(ph, "Perl error: %s\n", SvPV(ERRSV, count)); */
		if (!SvOK (POPs)) {}		/* remove undef from the top of the stack */
	} else if (count != 1) {
		xchat_printf (ph, "Perl error: expected 1 value from %s, "
						  "got: %d\n", function, count);
	} else {
		ret_value = POPi;
	}

	PUTBACK;
	FREETMPS;
	LEAVE;

	return ret_value;
}
Esempio n. 15
0
void _newiterator(rpmts ts, SV * sv_tagname, SV * sv_tagvalue, int keylen) {
    rpmmi mi;
    int tag = RPMDBI_PACKAGES;
    void * value = NULL;
    int i = 0;
    dSP;
    if (sv_tagname == NULL || !SvOK(sv_tagname)) {
        tag = RPMDBI_PACKAGES; /* Assume search into installed packages */
    } else {
        tag = sv2dbquerytag(sv_tagname);
    }
    if (sv_tagvalue != NULL && SvOK(sv_tagvalue)) {
        switch (tag) {
        case RPMDBI_PACKAGES:
            i = SvIV(sv_tagvalue);
            value = &i;
            keylen = sizeof(i);
            break;
        default:
            value = (void *) SvPV_nolen(sv_tagvalue);
            break;
        }
    }
    mi = rpmtsInitIterator(ts, tag, value, keylen);
    XPUSHs(sv_2mortal(sv_setref_pv(newSVpv("", 0), "RPM::PackageIterator", mi)));
    PUTBACK;
    return;
}
Esempio n. 16
0
static bool do_script_unload(const char *filename)
{
	bool retval = true;

	dSP;
	ENTER;

	SAVETMPS;
	PUSHMARK(SP);
	XPUSHs(sv_2mortal(newSVpv(filename, 0)));
	PUTBACK;

	call_pv("Atheme::Init::unload_script", 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;
}
/*
    NOTE: mouse_tc_check() handles GETMAGIC
*/
int
mouse_tc_check(pTHX_ SV* const tc_code, SV* const sv) {
    CV* const cv = (CV*)SvRV(tc_code);
    assert(SvTYPE(cv) == SVt_PVCV);

    if(CvXSUB(cv) == XS_Mouse_constraint_check){ /* built-in type constraints */
        MAGIC* const mg = (MAGIC*)CvXSUBANY(cv).any_ptr;

        assert(CvXSUBANY(cv).any_ptr != NULL);
        assert(mg->mg_ptr            != NULL);

        SvGETMAGIC(sv);
        /* call the check function directly, skipping call_sv() */
        return CALL_FPTR((check_fptr_t)mg->mg_ptr)(aTHX_ mg->mg_obj, sv);
    }
    else { /* custom */
        int ok;
        dSP;
        dMY_CXT;

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        XPUSHs(sv);
        if( MY_CXT.tc_extra_args ) {
            AV* const av  = MY_CXT.tc_extra_args;
            I32 const len = AvFILLp(av) + 1;
            int i;
            for(i = 0; i < len; i++) {
                XPUSHs( AvARRAY(av)[i] );
            }
        }
        PUTBACK;

        call_sv(tc_code, G_SCALAR);

        SPAGAIN;
        ok = sv_true(POPs);
        PUTBACK;

        FREETMPS;
        LEAVE;

        return ok;
    }
}
Esempio n. 18
0
char* perlcall (const char* sub, char* in, char* out, long item, char* input) {
	char *retval=NULL;
	int count, foo;
	an_array *array;
	dSP ;
	if (!isperlrunning){RETURN_MSTR(retval);}
	++perlcalldepth;
	ENTER; SAVETMPS;
	PUSHMARK(SP);
	if (input && *input) XPUSHs(sv_2mortal(newSVpv(input, 0)));
	if (in && *in && (array=get_array(in))) {
		for (foo=0; foo<array->size; foo++) {
			XPUSHs(sv_2mortal(newSVpv(array->item[foo], 0)));
		}
	}
	PUTBACK ;
	if (out && *out) {
		long size;
		upper(out);
		size=(array=get_array(out))?array->size:0;
		if (0>item) item=size-~item;
		if (item>size) item=-1;
	} else {
		item=-1;
	}
	if (0<=item) {
		I32 ax;
		count = perl_call_pv((char*)sub, G_EVAL|G_ARRAY);
		SPAGAIN ;
		SP -= count ;
		ax = (SP - PL_stack_base) + 1 ;
		for (foo=0; foo<count; foo++) {
			set_item(out, item+foo, (char*)SvPV_nolen(ST(foo)), 1);
		}
		retval=(void*)new_realloc((void**)(&retval),32);
		snprintf(retval,31,"%u",count);
	} else {
		SV *sv;
		count = perl_call_pv((char*)sub, G_EVAL|G_SCALAR);
		SPAGAIN ; sv=POPs ;
		SV2STR(sv,retval);
	}
	PUTBACK ;
	FREETMPS; LEAVE;
	--perlcalldepth;
	RETURN_MSTR(retval);
}
Esempio n. 19
0
File: perl.c Progetto: mdbarr/vcsi
/* run a perl function */
VCSI_OBJECT perl_func(VCSI_CONTEXT vc,
		      VCSI_OBJECT args,
		      int length) {

  dSP ;
  VCSI_OBJECT name,tmp,ret;
  SV* val;
  unsigned long len;
  int i, count;
  int flags = G_EVAL;

  /* stack stuff */ 
  ENTER ;
  SAVETMPS ;

  PUSHMARK(SP) ;
 
  if(length < 1)
    return error(vc,"invalid number of arguments to perl-func",args);

  if(length == 1)
    flags = flags | G_NOARGS;

  name = car(vc,args);
  args = cdr(vc,args);

  /* loop putting the args on the stack */
  for(tmp=args;tmp!=NULL;tmp=cdr(vc,tmp))  
    XPUSHs(sv_2mortal(perl_sv(vc,car(vc,tmp))));
 
  /* stack stuff */
  PUTBACK ;

  /* call the function */
  count = call_pv(STR(name),flags);

  /*printf("COUNT: %d\n",count);*/

  /* refresh the stack */
  SPAGAIN ;

  /* POP out results */
  for(i=0,ret=NULL;i<count;i++) {
    val = POPs;
    ret = cons(vc,perl_return(vc,val),ret);
  }

  if(cdr(vc,ret) == NULL)
    ret = car(vc,ret);
  
  /* clean up the stack */

  PUTBACK ;
  FREETMPS ;
  LEAVE ;

  /* return */
  return ret;
}
Esempio n. 20
0
static void
gtk2perl_cell_layout_add_attribute (GtkCellLayout         *cell_layout,
                                    GtkCellRenderer       *cell,
                                    const gchar           *attribute,
                                    gint                   column)
{
	GET_METHOD_OR_DIE (cell_layout, "ADD_ATTRIBUTE");

	{
		PREP (cell_layout);
		XPUSHs (sv_2mortal (newSVGtkCellRenderer (cell)));
		XPUSHs (sv_2mortal (newSVGChar (attribute)));
		XPUSHs (sv_2mortal (newSViv (column)));
		CALL;
		FINISH;
	}
}
Esempio n. 21
0
static int
command_cb (char *word[], char *word_eol[], void *userdata)
{
	HookData *data = (HookData *) userdata;
	int retVal = 0;
	int count = 0;

	dSP;
	ENTER;
	SAVETMPS;
	
	if (data->depth)
		return XCHAT_EAT_NONE;

	/*               xchat_printf (ph, "Recieved %d words in command callback", */
	/*                               av_len (wd)); */
	PUSHMARK (SP);
	XPUSHs (newRV_noinc ((SV *) array2av (word)));
	XPUSHs (newRV_noinc ((SV *) array2av (word_eol)));
	XPUSHs (data->userdata);
	PUTBACK;

	data->depth++;
	count = call_sv (data->callback, G_EVAL);
	data->depth--;
	SPAGAIN;
	if (SvTRUE (ERRSV)) {
		xchat_printf (ph, "Error in command callback %s", SvPV_nolen (ERRSV));
		if (!SvOK (POPs)) {}		  /* remove undef from the top of the stack */
		retVal = XCHAT_EAT_XCHAT;
	} else {
		if (count != 1) {
			xchat_print (ph, "Command handler should only return 1 value.");
			retVal = XCHAT_EAT_NONE;
		} else {
			retVal = POPi;
		}

	}

	PUTBACK;
	FREETMPS;
	LEAVE;

	return retVal;
}
Esempio n. 22
0
static void
set(SV *sv, SV *new_value, int imag)
{
  dSP;
  
  ENTER;
  SAVETMPS;
  PUSHMARK(SP);
  XPUSHs(sv);
  XPUSHs(new_value);
  PUTBACK;
  
  call_pv(imag ? "Math::Complex::Im" : "Math::Complex::Re", G_DISCARD);
  
  FREETMPS;
  LEAVE;
}
Esempio n. 23
0
void push_arguments(SV **sp, int len, SV *args[]) {
    int i;
    for (i = 0; i < len; i++) {
        if (args[i] != NULL) /* skip Nil which gets turned into NULL */
            XPUSHs(sv_2mortal(args[i]));
    }
    PUTBACK;
}
Esempio n. 24
0
int
perl_back_delete(
	Operation	*op,
	SlapReply	*rs )
{
	PerlBackend *perl_back = (PerlBackend *) op->o_bd->be_private;
	int count;

#if defined(HAVE_WIN32_ASPERL) || defined(USE_ITHREADS)
	PERL_SET_CONTEXT( PERL_INTERPRETER );
#endif
	ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex );	

	{
		dSP; ENTER; SAVETMPS;

		PUSHMARK(sp);
		XPUSHs( perl_back->pb_obj_ref );
		XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , 0 )));

		PUTBACK;

#ifdef PERL_IS_5_6
		count = call_method("delete", G_SCALAR);
#else
		count = perl_call_method("delete", G_SCALAR);
#endif

		SPAGAIN;

		if (count != 1) {
			croak("Big trouble in perl-back_delete\n");
		}

		rs->sr_err = POPi;

		PUTBACK; FREETMPS; LEAVE;
	}

	ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );	

	send_ldap_result( op, rs );

	Debug( LDAP_DEBUG_ANY, "Perl DELETE\n", 0, 0, 0 );
	return( 0 );
}
Esempio n. 25
0
/* Convert a bigint to a signed integer, or croak trying.
 *
 * @param bigint: the perl object to convert
 * @returns: signed integer
 */
static gint64
bigint2int64(SV *bigint)
{
    SV *sv;
    char *str;
    guint64 absval;
    gboolean negative = FALSE;
    int count;
    dSP;

    /* first, see if it's a BigInt */
    if (!sv_isobject(bigint) || !sv_derived_from(bigint, "Math::BigInt"))
	croak("Expected an integer or a Math::BigInt; cannot convert");

    ENTER;
    SAVETMPS;

    /* get the value:
     * strtoull($bigint->bstr()) */

    PUSHMARK(SP);
    XPUSHs(bigint);
    PUTBACK;

    count = call_method("Math::BigInt::bstr", G_SCALAR);

    SPAGAIN;

    if (count != 1)
	croak("Expected a result from Math::BigInt::bstr");

    sv = POPs;
    str = SvPV_nolen(sv);
    if (!str)
	croak("Math::BigInt::bstr did not return a string");

    if (str[0] == '-') {
	negative = TRUE;
	str++;
    }

    errno = 0;
    absval = g_ascii_strtoull(str, NULL, 0);
    /* (the last branch of this || depends on G_MININT64 = -G_MAXINT64-1) */
    if ((absval == G_MAXUINT64 && errno == ERANGE)
        || (!negative && absval > (guint64)(G_MAXINT64))
	|| (negative && absval > (guint64)(G_MAXINT64)+1))
	croak("Expected a signed 64-bit value or smaller; value '%s' out of range", str);
    if (errno)
	croak("Math::BigInt->bstr returned invalid number '%s'", str);

    PUTBACK;
    FREETMPS;
    LEAVE;

    if (negative) return -absval;
    return absval;
}
Esempio n. 26
0
/* Get a new specfile */
void _newspec(rpmts ts, char * filename, SV * svpassphrase, SV * svrootdir, SV * svcookies, SV * svanyarch, SV * svforce, SV * svverify) {
    Spec spec = NULL;
    char * passphrase = NULL;
    char * rootdir = NULL;
    char * cookies = NULL;
    int anyarch = 0;
    int force = 0;
    int verify = 0;
    dSP;

    if (svpassphrase && SvOK(svpassphrase))
        passphrase = SvPV_nolen(svpassphrase);

    if (svrootdir && SvOK(svrootdir))
        rootdir = SvPV_nolen(svrootdir);
    else
        rootdir = "/";

    if (svcookies && SvOK(svcookies))
        cookies = SvPV_nolen(svcookies);

    if (svanyarch && SvOK(svanyarch))
        anyarch = SvIV(svanyarch);

    if (svforce && SvOK(svforce))
        force = SvIV(svforce);

    if (svverify && SvOK(svverify))
        verify = SvIV(svverify);

    if (filename) {
        if (!parseSpec(ts, filename, rootdir, 0, passphrase, cookies, anyarch, force, verify))
            spec = rpmtsSetSpec(ts, NULL);
#ifdef HHACK
    } else {
        spec = newSpec();
#endif
    }
    if (spec) {
        XPUSHs(sv_2mortal(sv_setref_pv(newSVpv("", 0), "RPM::Spec", (void *)spec)));
    } else
        XPUSHs(sv_2mortal(&PL_sv_undef));
    PUTBACK;
    return;
}
Esempio n. 27
0
static void
Encode_XSEncoding(pTHX_ encode_t *enc)
{
 dSP;
 HV *stash = gv_stashpv("Encode::XS", TRUE);
 SV *sv    = sv_bless(newRV_noinc(newSViv(PTR2IV(enc))),stash);
 int i = 0;
 PUSHMARK(sp);
 XPUSHs(sv);
 while (enc->name[i])
  {
   const char *name = enc->name[i++];
   XPUSHs(sv_2mortal(newSVpvn(name,strlen(name))));
  }
 PUTBACK;
 call_pv("Encode::define_encoding",G_DISCARD);
 SvREFCNT_dec(sv);
}
Esempio n. 28
0
/* 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;
}
Esempio n. 29
0
static void push_thread(pTHX, mthread* thread) {
	{
		dSP;
		SV* to_push = newRV_noinc(newSVuv(thread->id));
		sv_bless(to_push, gv_stashpv("threads::lite::tid", FALSE));
		XPUSHs(to_push);
		PUTBACK;
	}
}
Esempio n. 30
0
void DoDump(SV *dumpme) {
  dSP;

  PUSHMARK(SP);
  XPUSHs(dumpme);
  PUTBACK;

  call_pv("Devel::Peek::Dump", G_DISCARD);
}