コード例 #1
0
ファイル: rlm_perl.c プロジェクト: Antti/freeradius-server
static PerlInterpreter *rlm_perl_clone(PerlInterpreter *perl)
{
	PerlInterpreter *interp;
	UV clone_flags = 0;

	PERL_SET_CONTEXT(perl);

	pthread_once(&rlm_perl_once, rlm_perl_make_key);

	interp = pthread_getspecific(rlm_perl_key);
	if (interp) return interp;

	interp = perl_clone(perl, clone_flags);
	{
		dTHXa(interp);
	}
#if PERL_REVISION >= 5 && PERL_VERSION <8
	call_pv("CLONE",0);
#endif
	ptr_table_free(PL_ptr_table);
	PL_ptr_table = NULL;

	PERL_SET_CONTEXT(aTHX);
    	rlm_perl_clear_handles(aTHX);

	pthread_setspecific(rlm_perl_key, interp);

	fprintf(stderr, "GOT CLONE %d %p\n", pthread_self(), interp);

	return interp;
}
コード例 #2
0
ファイル: rlm_perl.c プロジェクト: geaaru/freeradius-server
static PerlInterpreter *rlm_perl_clone(PerlInterpreter *perl, pthread_key_t *key)
{
	int ret;

	PerlInterpreter *interp;
	UV clone_flags = 0;

	PERL_SET_CONTEXT(perl);

	interp = pthread_getspecific(*key);
	if (interp) return interp;

	interp = perl_clone(perl, clone_flags);
	{
		dTHXa(interp);
	}
#  if PERL_REVISION >= 5 && PERL_VERSION <8
	call_pv("CLONE",0);
#  endif
	ptr_table_free(PL_ptr_table);
	PL_ptr_table = NULL;

	PERL_SET_CONTEXT(aTHX);
	rlm_perl_clear_handles(aTHX);

	ret = pthread_setspecific(*key, interp);
	if (ret != 0) {
		DEBUG("Failed associating interpretor with thread %s", fr_syserror(ret));

		rlm_perl_destruct(interp);
		return NULL;
	}

	return interp;
}
コード例 #3
0
static PerlInterpreter *rlm_perl_clone(PerlInterpreter *perl, pthread_key_t *key)
{
	PerlInterpreter *interp;
	UV clone_flags = 0;

	PERL_SET_CONTEXT(perl);

	interp = pthread_getspecific(*key);
	if (interp) return interp;

	interp = perl_clone(perl, clone_flags);
	{
		dTHXa(interp);
	}
#if PERL_REVISION >= 5 && PERL_VERSION <8
	call_pv("CLONE",0);
#endif
	ptr_table_free(PL_ptr_table);
	PL_ptr_table = NULL;

	PERL_SET_CONTEXT(aTHX);
    	rlm_perl_clear_handles(aTHX);

	pthread_setspecific(*key, interp);

	return interp;
}
コード例 #4
0
ファイル: nsperl2.c プロジェクト: aufflick/nsperl2
/* lazily maintain 1:1 mapping between tcl and perl interpreters */
perl_context *nsperl2_get_assoc_perl_context (Tcl_Interp *interp)
{
    extern perl_master_context *nsperl2_master_context;
    assert (nsperl2_master_context);
    perl_context *context = Tcl_GetAssocData (interp, "nsperl2:perl_context", NULL);
    PerlInterpreter *perl_interp;

    if(context)
        return context;

    Ns_Log (Notice, "cloning perl interpreter for tcl interp");

    PERL_SET_CONTEXT (nsperl2_master_context->perl_master_interp);

    if ((perl_interp = perl_clone (nsperl2_master_context->perl_master_interp, CLONEf_KEEP_PTR_TABLE)) == NULL) {
        Ns_Log (Error, "Couldn't clone perl interp");
        return NULL;
        }

    /* save the perl interp */
    context = ns_malloc (sizeof(perl_context));
    context->perl_interp = perl_interp;
    Tcl_SetAssocData(interp, "nsperl2:perl_context", nsperl2_delete_assoc_perl, context);

    return context;
}
コード例 #5
0
static PerlInterpreter *
clone_perl_interpreter (void *parent_intrp, char *err, int max_len)
{
  PerlInterpreter *intrp = (PerlInterpreter *) parent_intrp;
  UV clone_flags = CLONEf_KEEP_PTR_TABLE;

#if defined(WIN32) && defined(CLONEf_CLONE_HOST)
  clone_flags |= CLONEf_CLONE_HOST;
#endif

  log_debug ("clone_perl_interpreter");
  PERL_SET_CONTEXT(intrp);
  return perl_clone (intrp, clone_flags);
}
コード例 #6
0
static PerlInterpreter *rlm_perl_clone(PerlInterpreter *perl)
{
	PerlInterpreter *clone;
	UV	clone_flags = 0;

	PERL_SET_CONTEXT(perl);

	clone = perl_clone(perl, clone_flags);
	{
		dTHXa(clone);
	}
#if PERL_REVISION >= 5 && PERL_VERSION <8
	call_pv("CLONE",0);
#endif
	ptr_table_free(PL_ptr_table);
	PL_ptr_table = NULL;

	PERL_SET_CONTEXT(aTHX);
    	rlm_perl_clear_handles(aTHX);

	return clone;
}
コード例 #7
0
ファイル: perllib.c プロジェクト: andreisoltan/csc469
EXTERN_C DllExport int
RunPerl(int argc, char **argv, char **env)
{
    int exitstatus;
    PerlInterpreter *my_perl, *new_perl = NULL;

#ifndef __BORLANDC__
    /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
     * want to free() argv after main() returns.  As luck would have it,
     * Borland's CRT does the right thing to argv[0] already. */
    char szModuleName[MAX_PATH];

    GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
    (void)win32_longpath(szModuleName);
    argv[0] = szModuleName;
#endif

#ifdef PERL_GLOBAL_STRUCT
#define PERLVAR(var,type) /**/
#define PERLVARA(var,type) /**/
#define PERLVARI(var,type,init) PL_Vars.var = init;
#define PERLVARIC(var,type,init) PL_Vars.var = init;
#include "perlvars.h"
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
#endif

    PERL_SYS_INIT(&argc,&argv);

    if (!(my_perl = perl_alloc()))
	return (1);
    perl_construct(my_perl);
    PL_perl_destruct_level = 0;

    exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
    if (!exitstatus) {
#if defined(TOP_CLONE) && defined(USE_ITHREADS)		/* XXXXXX testing */
	new_perl = perl_clone(my_perl, 1);
	exitstatus = perl_run(new_perl);
	PERL_SET_THX(my_perl);
#else
	exitstatus = perl_run(my_perl);
#endif
    }

    perl_destruct(my_perl);
    perl_free(my_perl);
#ifdef USE_ITHREADS
    if (new_perl) {
	PERL_SET_THX(new_perl);
	perl_destruct(new_perl);
	perl_free(new_perl);
    }
#endif

    PERL_SYS_TERM();

    return (exitstatus);
}
コード例 #8
0
ファイル: interface.cpp プロジェクト: rurban/perl
EXTERN_C
int RunPerl(int argc, char **argv, char **env)
{
	int exitstatus = 0;
	ClsPerlHost nlm;

	PerlInterpreter *my_perl = NULL;		// defined in Perl.h
	PerlInterpreter *new_perl = NULL;		// defined in Perl.h

	//__asm{int 3};
	#ifdef PERL_GLOBAL_STRUCT
		#define PERLVAR(prefix,var,type)
		#define PERLVARA(prefix,var,type)
		#define PERLVARI(prefix,var,type,init) PL_Vars.prefix##var = init;
		#define PERLVARIC(prefix,var,type,init) PL_Vars.prefix##var = init;

		#include "perlvars.h"

		#undef PERLVAR
		#undef PERLVARA
		#undef PERLVARI
		#undef PERLVARIC
	#endif

	PERL_SYS_INIT(&argc, &argv);

	if (!(my_perl = perl_alloc()))		// Allocate memory for Perl.
		return (1);

	if(nlm.PerlCreate(my_perl))
	{
		PL_perl_destruct_level = 0;

		if(!nlm.PerlParse(my_perl, argc, argv, env))
		{
			#if defined(TOP_CLONE) && defined(USE_ITHREADS)		// XXXXXX testing
				#  ifdef PERL_OBJECT
					CPerlHost *h = new CPerlHost();
					new_perl = perl_clone_using(my_perl, 1,
										h->m_pHostperlMem,
										h->m_pHostperlMemShared,
										h->m_pHostperlMemParse,
										h->m_pHostperlEnv,
										h->m_pHostperlStdIO,
										h->m_pHostperlLIO,
										h->m_pHostperlDir,
										h->m_pHostperlSock,
										h->m_pHostperlProc
										);
					CPerlObj *pPerl = (CPerlObj*)new_perl;
				#  else
					new_perl = perl_clone(my_perl, 1);
				#  endif

				(void) perl_run(new_perl);	// Run Perl.
				PERL_SET_THX(my_perl);
			#else
				(void) nlm.PerlRun(my_perl);
			#endif
		}
		exitstatus = nlm.PerlDestroy(my_perl);
	}
	if(my_perl)
		nlm.PerlFree(my_perl);

	#ifdef USE_ITHREADS
		if (new_perl)
		{
			PERL_SET_THX(new_perl);
			exitstatus = nlm.PerlDestroy(new_perl);
			nlm.PerlFree(my_perl);
		}
	#endif

	PERL_SYS_TERM();
	return exitstatus;
}
コード例 #9
0
ファイル: mod_perl.c プロジェクト: AricGod/FreeSWITCH
static PerlInterpreter *clone_perl(void)
{
	PerlInterpreter *my_perl = perl_clone(globals.my_perl, CLONEf_COPY_STACKS | CLONEf_KEEP_PTR_TABLE);
	PERL_SET_CONTEXT(my_perl);
	return my_perl;
}