Exemple #1
0
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);
}
Exemple #2
0
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;
}