EXTERN_C void xs_init (pTHX);

using namespace std;

CPerlEngine::CPerlEngine(char* pScriptFile) :
		mInterpreter(NULL),
		mScriptFile(pScriptFile)
{
  this->mInterpreter = ::perl_alloc();
  assert (this->mInterpreter != NULL);

  PERL_SET_CONTEXT(this->mInterpreter);

  ::perl_construct(this->mInterpreter);

  char* theArguments[] = {"-x", "-S", "-s", pScriptFile};

  ::perl_parse(this->mInterpreter, 
		&xs_init, 
		4, 
		theArguments, 
		NULL);
  PL_exit_flags |= PERL_EXIT_DESTRUCT_END;

  ::perl_run(this->mInterpreter);
}

CPerlEngine::~CPerlEngine(void)
{
  ::perl_destruct(this->mInterpreter);
  ::perl_free(this->mInterpreter);
}


void
CPerlEngine::invoke(const char* pFunctionName,
	vector<string> pParameters) 
{
  assert (NULL != this->mInterpreter);

  PERL_SET_CONTEXT(this->mInterpreter);

  //  Pick up all the stack info in *this* threads local storage
  dTHX;

#ifdef PERL_CLONE_WORKS
  PerlInterpreter* newInterpreter = ::perl_clone(this->mInterpreter, 
  CLONEf_COPY_STACKS | CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST);
//  PerlInterpreter* newInterpreter = ::perl_clone(this->mInterpreter, CLONEf_CLONE_HOST);
//  PerlInterpreter* newInterpreter = ::perl_clone(this->mInterpreter, NULL);
#else
  PerlInterpreter* newInterpreter = this->mInterpreter;
#endif

  assert (NULL != newInterpreter);

  ::perl_run(newInterpreter);

  dSP;
  ENTER;
  SAVETMPS;
  PUSHMARK(SP);

  for (vector<string>::iterator theIterator = pParameters.begin(); 
	theIterator != pParameters.end(); 
	theIterator++)
  {
    if (theIterator->length() > 0)
    {
      XPUSHs(::newSVpv(theIterator->c_str(), theIterator->length()));
    }
  }

  PUTBACK;
  ::call_pv(pFunctionName, G_DISCARD);
  FREETMPS;
  LEAVE;

#ifdef PERL_CLONE_WORKS
  ::perl_free(newInterpreter);
#endif
}