~rsrchboy/+junk/ndn-perl

/*

 * Copyright © 2001 Novell, Inc. All Rights Reserved.

 *

 * You may distribute under the terms of either the GNU General Public

 * License or the Artistic License, as specified in the README file.

 *

 */

/*

 * FILENAME		:	interface.c

 * DESCRIPTION	:	Perl parsing and running functions.

 * Author		:	SGP

 * Date			:	January 2001.

 *

 */

#include "interface.h"

#include "win32ish.h"		// For "BOOL", "TRUE" and "FALSE"

static void xs_init(pTHX);

//static void xs_init(pTHXo); //(J)

EXTERN_C int RunPerl(int argc, char **argv, char **env);

EXTERN_C void Perl_nw5_init(int *argcp, char ***argvp);

EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);	// (J) pTHXo_

EXTERN_C BOOL Remove_Thread_Ctx(void);

ClsPerlHost::ClsPerlHost()

{

}

ClsPerlHost::~ClsPerlHost()

{

}

ClsPerlHost::VersionNumber()

{

	return 0;

}

int

ClsPerlHost::PerlCreate(PerlInterpreter *my_perl)

{

/*	if (!(my_perl = perl_alloc()))		// Allocate memory for Perl.

		return (1);*/

    perl_construct(my_perl);

	return 1;

}

int

ClsPerlHost::PerlParse(PerlInterpreter *my_perl, int argc, char** argv, char** env)

{

	return(perl_parse(my_perl, xs_init, argc, argv, env));		// Parse the command line.

}

int

ClsPerlHost::PerlRun(PerlInterpreter *my_perl)

{

	return(perl_run(my_perl));	// Run Perl.

}

void

ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)

{

	perl_destruct(my_perl);		// Destructor for Perl.

////	perl_free(my_perl);			// Free the memory allocated for Perl.

}

void

ClsPerlHost::PerlFree(PerlInterpreter *my_perl)

{

	perl_free(my_perl);			// Free the memory allocated for Perl.

	// Remove the thread context set during Perl_set_context

	// This is added here since for web script there is no other place this gets executed

	// and it cannot be included into cgi2perl.xs unless this symbol is exported.

	Remove_Thread_Ctx();

}

/*============================================================================================

 Function		:	xs_init

 Description	:	

 Parameters 	:	pTHX	(IN)	-	

 Returns		:	Nothing.

==============================================================================================*/

static void xs_init(pTHX)

//static void xs_init(pTHXo) //J

{

	char *file = __FILE__;

	dXSUB_SYS;

	newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);

}

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;

		exitstatus = nlm.PerlParse(my_perl, argc, argv, env);

		if(exitstatus == 0)

		{

			#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

				exitstatus = perl_run(new_perl);	// Run Perl.

				PERL_SET_THX(my_perl);

			#else

				exitstatus = nlm.PerlRun(my_perl);

			#endif

		}

		nlm.PerlDestroy(my_perl);

	}

	if(my_perl)

		nlm.PerlFree(my_perl);

	#ifdef USE_ITHREADS

		if (new_perl)

		{

			PERL_SET_THX(new_perl);

			nlm.PerlDestroy(new_perl);

			nlm.PerlFree(my_perl);

		}

	#endif

	PERL_SYS_TERM();

	return exitstatus;

}

// FUNCTION: AllocStdPerl

//

// DESCRIPTION:

//	Allocates a standard perl handler that other perl handlers

//	may delegate to. You should call FreeStdPerl to free this

//	instance when you are done with it.

//

IPerlHost* AllocStdPerl()

{

	return (IPerlHost*) new ClsPerlHost();

}

// FUNCTION: FreeStdPerl

//

// DESCRIPTION:

//	Frees an instance of a standard perl handler allocated by

//	AllocStdPerl.

//

void FreeStdPerl(IPerlHost* pPerlHost)

{

	if (pPerlHost)

		delete (ClsPerlHost*) pPerlHost;

////		delete pPerlHost;

}