/* 
 * we fake up some parts of the CRT that aren't exported by MSVCRT.dll 
 * this lets sockets work on Win9X with GCC and should fix the problems 
 * with perl95.exe 
 *      -- BKS, 1-23-2000 
*/ 

##</code><code>##

__declspec(dllexport)

long CFTPerlUserExitInstanceRun(char *FileName,char *FuncName,struct PerlParmInfo *ParmsVec,unsigned int ParmsVecSize,char* pReason,int *pCount,int *pUserExitRc, int *pPerlParseRc)
{
   long lRc = 0;
   int count = -1;
   PerlInterpreter* my_perl = NULL;
   char *embedding[] = { "", FileName};

   while (true)
   {
      my_perl = perl_alloc();
      if (my_perl == NULL)
      {
         lRc = -1;
         break;
      }

      EnterCriticalSection(&g_ParserCS); 

      try
      {
         PERL_SET_CONTEXT(my_perl);
         PL_perl_destruct_level = 1;
         perl_construct(my_perl);
         *pPerlParseRc = perl_parse(my_perl, xs_init, 2, embedding , NULL);
         lRc = *pPerlParseRc;

         LeaveCriticalSection(&g_ParserCS);
      }
      catch(...)
      {
         LeaveCriticalSection(&g_ParserCS); 
         lRc = -6;
         break;
      }
 
      if (lRc != 0)
      {
         lRc = -2;
         break;
      }

      dSP;
      ENTER;
      SAVETMPS;
      PUSHMARK(SP);
 
      // Here I push parameters into the stack…

      PUTBACK;        

      try
      {
         count = call_pv(FuncName, _EVAL|G_SCALAR);        
      }
      catch(...)
      {
         lRc = -3;
      }
 
      SPAGAIN;
 
      // Check the eval first 
      if (SvTRUE(ERRSV))
      {
         STRLEN n_a;
         strncpy(pReason, SvPV(ERRSV, n_a), MAX_PERL_REASON_LENGTH-1);
         lRc = -4;
         POPs ;
      }
      else
      {
         if (count != 1)
         {
            *pCount = count;
            lRc = -5;
         }
         else
         {
            *pUserExitRc = POPi;
         }
      }

      PUTBACK ;
      FREETMPS ;
      LEAVE ;
 
      break;
   }
 
   if (my_perl != NULL)
   {
      EnterCriticalSection(&g_ParserCS);
      try
      {
         PL_perl_destruct_level = 1;
         perl_destruct(my_perl);
         LeaveCriticalSection(&g_ParserCS);
      }
      catch(...)
      {
         LeaveCriticalSection(&g_ParserCS);
         lRc = -7;
      }
 
      perl_free(my_perl);
   }
 
   return lRc;
}