win32/perllib.c

   1 /*
   2  * "The Road goes ever on and on, down from the door where it began."
   3  */
   4
   5 #ifdef __cplusplus
   6 extern "C" {
   7 #endif
   8
   9 #include "EXTERN.h"
  10 #include "perl.h"
  11
  12 #ifdef __cplusplus
  13 }
  14 #  define EXTERN_C extern "C"
  15 #else
  16 #  define EXTERN_C extern
  17 #endif
  18
  19 static void xs_init _((void));
  20
  21 __declspec(dllexport) int
  22 RunPerl(int argc, char **argv, char **env, void *iosubsystem)
  23 {
  24     int exitstatus;
  25     PerlInterpreter *my_perl;
  26     void *pOldIOSubsystem;
  27
  28     pOldIOSubsystem = SetIOSubSystem(iosubsystem);
  29
  30     PERL_SYS_INIT(&argc,&argv);
  31
  32     perl_init_i18nl10n(1);
  33
  34     if (!(my_perl = perl_alloc()))
  35         return (1);
  36     perl_construct( my_perl );
  37     perl_destruct_level = 0;
  38
  39     exitstatus = perl_parse( my_perl, xs_init, argc, argv, env);
  40     if (!exitstatus) {
  41         exitstatus = perl_run( my_perl );
  42     }
  43
  44     perl_destruct( my_perl );
  45     perl_free( my_perl );
  46
  47     PERL_SYS_TERM();
  48
  49     SetIOSubSystem(pOldIOSubsystem);
  50
  51     return (exitstatus);
  52 }
  53
  54 /* Register any extra external extensions */
  55
  56 char *staticlinkmodules[] = {
  57     "DynaLoader",
  58     NULL,
  59 };
  60
  61 EXTERN_C void boot_DynaLoader _((CV* cv));
  62
  63 static void
  64 xs_init()
  65 {
  66     char *file = __FILE__;
  67     dXSUB_SYS;
  68
  69     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
  70 }
  71
  72 extern HANDLE PerlDllHandle;
  73
  74 BOOL APIENTRY
  75 DllMain(HANDLE hModule,         /* DLL module handle */
  76         DWORD fdwReason,        /* reason called */
  77         LPVOID lpvReserved)     /* reserved */
  78 {
  79     switch (fdwReason) {
  80         /* The DLL is attaching to a process due to process
  81          * initialization or a call to LoadLibrary.
  82          */
  83     case DLL_PROCESS_ATTACH:
  84 /* #define DEFAULT_BINMODE */
  85 #ifdef DEFAULT_BINMODE
  86         _setmode( _fileno( stdin  ), _O_BINARY );
  87         _setmode( _fileno( stdout ), _O_BINARY );
  88         _setmode( _fileno( stderr ), _O_BINARY );
  89         _fmode = _O_BINARY;
  90 #endif
  91         PerlDllHandle = hModule;
  92         break;
  93
  94         /* The DLL is detaching from a process due to
  95          * process termination or call to FreeLibrary.
  96          */
  97     case DLL_PROCESS_DETACH:
  98         break;
  99
 100         /* The attached process creates a new thread. */
 101     case DLL_THREAD_ATTACH:
 102         break;
 103
 104         /* The thread of the attached process terminates. */
 105     case DLL_THREAD_DETACH:
 106         break;
 107
 108     default:
 109         break;
 110     }
 111     return TRUE;
 112 }