#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>

#include <string.h>

#ifdef USE_THREADS
/* include PERL xs_init code for module and C library support */

EXTERN_C void xs_init (pTHX);

EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);

EXTERN_C void
xs_init(pTHXo)
{
	char *file = __FILE__;

	/* DynaLoader is a special case */
	newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}
#else
#  if defined(__cplusplus) && !defined(PERL_OBJECT)
#    define is_cplusplus
#  endif

#  ifdef is_cplusplus
extern "C" {
#  endif

#  ifdef PERL_OBJECT
#    define NO_XSLOCKS
#    include "win32iop.h"
#    include <fcntl.h>
#    include <perlhost.h>
#  endif
#  ifdef is_cplusplus
}
#  ifndef EXTERN_C
#    define EXTERN_C extern "C"
#  endif
#  else
#    ifndef EXTERN_C
#      define EXTERN_C extern
#    endif
#  endif

EXTERN_C void xs_init _((void));

EXTERN_C void boot_DynaLoader _((CV* cv));

EXTERN_C void
xs_init(void)
{
	char *file = __FILE__;
	dXSUB_SYS;

	/* DynaLoader is a special case */
	newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}
#endif

static PerlInterpreter *perl = NULL;


int main(int argc, char **argv, char **env){

#ifdef USE_THREADS
	dTHX;
#endif

	char *embedding[] = { "", "p1.pl" };
	char plugin_output[1024];
	char buffer[512];
	char tmpfname[32];
	char fname[32];
	char *args[] = {"","0", "", "", NULL };
	FILE *fp;

	char command_line[80];
	int exitstatus;
	int pclose_result;

	if((perl=perl_alloc())==NULL){
		snprintf(buffer,sizeof(buffer),"Error: Could not allocate memory for embedded Perl interpreter!\n");
		buffer[sizeof(buffer)-1]='\x0';
		printf("%s\n", buffer);
		exit(1);
	}
	perl_construct(perl);
	exitstatus=perl_parse(perl,xs_init,2,embedding,NULL);
	if(!exitstatus) {

		exitstatus=perl_run(perl);

	        while(printf("Enter file name: ") && fgets(command_line, 80, stdin)) {

			dSP;


	                /* call the subroutine, passing it the filename as an argument */

			command_line[strlen(command_line) -1] = '\0';

                        strncpy(fname,command_line,strcspn(command_line," "));
                        fname[strcspn(command_line," ")] = '\x0';
                        args[0] = fname ;
                        args[3] = command_line + strlen(fname) + 1 ;

                        /* generate a temporary filename to which stdout can be redirected. */
                        sprintf(tmpfname,"/tmp/embedded%d",getpid());
                        args[2] = tmpfname;

			/* call our perl interpreter to compile and optionally cache the command */
			perl_call_argv("Embed::Persistent::eval_file", G_DISCARD | G_EVAL, args);

			ENTER; 
			SAVETMPS;
			PUSHMARK(SP);
			XPUSHs(sv_2mortal(newSVpv(args[0],0)));
			XPUSHs(sv_2mortal(newSVpv(args[1],0)));
			XPUSHs(sv_2mortal(newSVpv(args[2],0)));
			XPUSHs(sv_2mortal(newSVpv(args[3],0)));
			PUTBACK;
			perl_call_pv("Embed::Persistent::run_package", G_EVAL);
			SPAGAIN;
			pclose_result=POPi;
			PUTBACK;
			FREETMPS;
			LEAVE;

			/* check return status  */
			if(SvTRUE(ERRSV)){
				pclose_result=-2;
				printf("embedded perl ran %s with error %s\n",fname,SvPV(ERRSV,PL_na));
			}
			
			/* read back stdout from script */
			fp=fopen(tmpfname, "r");
			
			/* default return string in case nothing was returned */
			strcpy(plugin_output,"(No output!)");
			
			fgets(plugin_output,sizeof(plugin_output)-1,fp);
			plugin_output[sizeof(plugin_output)-1]='\x0';
			fclose(fp);
			unlink(tmpfname);    
			printf("embedded perl plugin return code and output was: %d & '%s'\n",pclose_result, plugin_output);

		}

	}

	
        PL_perl_destruct_level = 0;
        perl_destruct(perl);
        perl_free(perl);
        exit(exitstatus);
}