win32/runperl.c

   1
   2 #ifdef PERL_OBJECT
   3 #define USE_SOCKETS_AS_HANDLES
   4 #include "EXTERN.h"
   5 #include "perl.h"
   6
   7 #define NO_XSLOCKS
   8 #include "XSUB.H"
   9 #undef errno
  10 #if defined(_MT)
  11 _CRTIMP int * __cdecl _errno(void);
  12 #define errno (*_errno())
  13 #else
  14 _CRTIMP extern int errno;
  15 #endif
  16
  17 #include <ipdir.h>
  18 #include <ipenv.h>
  19 #include <ipsock.h>
  20 #include <iplio.h>
  21 #include <ipmem.h>
  22 #include <ipproc.h>
  23
  24 #include "ipstdiowin.h"
  25 #include "ipdir.c"
  26 #include "ipenv.c"
  27 #include "ipsock.c"
  28 #include "iplio.c"
  29 #include "ipmem.c"
  30 #include "ipproc.c"
  31 #include "ipstdio.c"
  32
  33 static void xs_init _((CPERLarg));
  34 #define stderr (&_iob[2])
  35 #undef fprintf
  36 #undef environ
  37
  38 class CPerlHost
  39 {
  40 public:
  41         CPerlHost() { pPerl = NULL; };
  42         inline BOOL PerlCreate(void)
  43         {
  44                 try
  45                 {
  46                         pPerl = perl_alloc(&perlMem,
  47                                                                 &perlEnv,
  48                                                                 &perlStdIO,
  49                                                                 &perlLIO,
  50                                                                 &perlDir,
  51                                                                 &perlSock,
  52                                                                 &perlProc);
  53                         if(pPerl != NULL)
  54                         {
  55                                 perlDir.SetPerlObj(pPerl);
  56                                 perlEnv.SetPerlObj(pPerl);
  57                                 perlLIO.SetPerlObj(pPerl);
  58                                 perlLIO.SetSockCtl(&perlSock);
  59                                 perlLIO.SetStdObj(&perlStdIO);
  60                                 perlMem.SetPerlObj(pPerl);
  61                                 perlProc.SetPerlObj(pPerl);
  62                                 perlSock.SetPerlObj(pPerl);
  63                                 perlSock.SetStdObj(&perlStdIO);
  64                                 perlStdIO.SetPerlObj(pPerl);
  65                                 perlStdIO.SetSockCtl(&perlSock);
  66                                 try
  67                                 {
  68                                         pPerl->perl_construct();
  69                                 }
  70                                 catch(...)
  71                                 {
  72                                         fprintf(stderr, "%s\n", "Error: Unable to construct data structures");
  73                                         pPerl->perl_free();
  74                                         pPerl = NULL;
  75                                 }
  76                         }
  77                 }
  78                 catch(...)
  79                 {
  80                         fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
  81                         pPerl = NULL;
  82                 }
  83                 return (pPerl != NULL);
  84         };
  85         inline int PerlParse(int argc, char** argv, char** env)
  86         {
  87                 char* environ = NULL;
  88                 int retVal;
  89                 try
  90                 {
  91                         retVal = pPerl->perl_parse(xs_init, argc, argv, (env == NULL || *env == NULL ? &environ : env));
  92                 }
  93                 catch(int x)
  94                 {
  95                         // this is where exit() should arrive
  96                         retVal = x;
  97                 }
  98                 catch(...)
  99                 {
 100                         fprintf(stderr, "Error: Parse exception\n");
 101                         retVal = -1;
 102                 }
 103                 return retVal;
 104         };
 105         inline int PerlRun(void)
 106         {
 107                 int retVal;
 108                 try
 109                 {
 110                         retVal = pPerl->perl_run();
 111                 }
 112                 catch(int x)
 113                 {
 114                         // this is where exit() should arrive
 115                         retVal = x;
 116                 }
 117                 catch(...)
 118                 {
 119                         fprintf(stderr, "Error: Runtime exception\n");
 120                         retVal = -1;
 121                 }
 122                 return retVal;
 123         };
 124         inline void PerlDestroy(void)
 125         {
 126                 try
 127                 {
 128                         pPerl->perl_destruct();
 129                         pPerl->perl_free();
 130                 }
 131                 catch(...)
 132                 {
 133                 }
 134         };
 135
 136 protected:
 137         CPerlObj        *pPerl;
 138         CPerlDir        perlDir;
 139         CPerlEnv        perlEnv;
 140         CPerlLIO        perlLIO;
 141         CPerlMem        perlMem;
 142         CPerlProc       perlProc;
 143         CPerlSock       perlSock;
 144         CPerlStdIO      perlStdIO;
 145 };
 146
 147 #undef PERL_SYS_INIT
 148 #define PERL_SYS_INIT(a, c)
 149
 150 int
 151 main(int argc, char **argv, char **env)
 152 {
 153         CPerlHost host;
 154         int exitstatus = 1;
 155
 156         if(!host.PerlCreate())
 157                 exit(exitstatus);
 158
 159
 160         exitstatus = host.PerlParse(argc, argv, env);
 161
 162         if (!exitstatus)
 163         {
 164                 exitstatus = host.PerlRun();
 165     }
 166
 167         host.PerlDestroy();
 168
 169     return exitstatus;
 170 }
 171
 172
 173 static void xs_init(CPERLarg)
 174 {
 175 }
 176
 177 EXTERN_C void boot_DynaLoader _((CPERLarg_ CV* cv))
 178 {
 179 }
 180
 181 #else  /* PERL_OBJECT */
 182
 183 /* Say NO to CPP! Hallelujah! */
 184 #ifdef __GNUC__
 185 /*
 186  * GNU C does not do __declspec()
 187  */
 188 #define __declspec(foo)
 189
 190 /* Mingw32 defaults to globing command line
 191  * This is inconsistent with other Win32 ports and
 192  * seems to cause trouble with passing -DXSVERSION=\"1.6\"
 193  * So we turn it off like this:
 194  */
 195 int _CRT_glob = 0;
 196
 197 #endif
 198
 199
 200 __declspec(dllimport) int RunPerl(int argc, char **argv, char **env, void *ios);
 201
 202 int
 203 main(int argc, char **argv, char **env)
 204 {
 205     return RunPerl(argc, argv, env, (void*)0);
 206 }
 207
 208 #endif  /* PERL_OBJECT */