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 #include "XSUB.h"
  12
  13 #ifdef __cplusplus
  14 }
  15 #  define EXTERN_C extern "C"
  16 #else
  17 #  define EXTERN_C extern
  18 #endif
  19
  20 static void xs_init _((void));
  21
  22 __declspec(dllexport) int
  23 RunPerl(int argc, char **argv, char **env, void *iosubsystem)
  24 {
  25     int exitstatus;
  26     PerlInterpreter *my_perl;
  27     void *pOldIOSubsystem;
  28
  29     pOldIOSubsystem = SetIOSubSystem(iosubsystem);
  30
  31     PERL_SYS_INIT(&argc,&argv);
  32
  33     perl_init_i18nl10n(1);
  34
  35     if (!(my_perl = perl_alloc()))
  36         return (1);
  37     perl_construct( my_perl );
  38     perl_destruct_level = 0;
  39
  40     exitstatus = perl_parse( my_perl, xs_init, argc, argv, env);
  41     if (!exitstatus) {
  42         exitstatus = perl_run( my_perl );
  43     }
  44
  45     perl_destruct( my_perl );
  46     perl_free( my_perl );
  47
  48     PERL_SYS_TERM();
  49
  50     SetIOSubSystem(pOldIOSubsystem);
  51
  52     return (exitstatus);
  53 }
  54
  55 extern HANDLE PerlDllHandle;
  56
  57 BOOL APIENTRY
  58 DllMain(HANDLE hModule,         /* DLL module handle */
  59         DWORD fdwReason,        /* reason called */
  60         LPVOID lpvReserved)     /* reserved */
  61 {
  62     switch (fdwReason) {
  63         /* The DLL is attaching to a process due to process
  64          * initialization or a call to LoadLibrary.
  65          */
  66     case DLL_PROCESS_ATTACH:
  67 /* #define DEFAULT_BINMODE */
  68 #ifdef DEFAULT_BINMODE
  69         _setmode( _fileno( stdin  ), _O_BINARY );
  70         _setmode( _fileno( stdout ), _O_BINARY );
  71         _setmode( _fileno( stderr ), _O_BINARY );
  72         _fmode = _O_BINARY;
  73 #endif
  74         PerlDllHandle = hModule;
  75         break;
  76
  77         /* The DLL is detaching from a process due to
  78          * process termination or call to FreeLibrary.
  79          */
  80     case DLL_PROCESS_DETACH:
  81         break;
  82
  83         /* The attached process creates a new thread. */
  84     case DLL_THREAD_ATTACH:
  85         break;
  86
  87         /* The thread of the attached process terminates. */
  88     case DLL_THREAD_DETACH:
  89         break;
  90
  91     default:
  92         break;
  93     }
  94     return TRUE;
  95 }
  96
  97 /* Register any extra external extensions */
  98
  99 char *staticlinkmodules[] = {
 100     "DynaLoader",
 101     NULL,
 102 };
 103
 104 EXTERN_C void boot_DynaLoader _((CV* cv));
 105
 106 static
 107 XS(w32_GetCurrentDirectory)
 108 {
 109     dXSARGS;
 110     SV *sv = sv_newmortal();
 111     /* Make one call with zero size - return value is required size */
 112     DWORD len = GetCurrentDirectory((DWORD)0,NULL);
 113     SvUPGRADE(sv,SVt_PV);
 114     SvGROW(sv,len);
 115     SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
 116     /*
 117      * If result != 0
 118      *   then it worked, set PV valid,
 119      *   else leave it 'undef'
 120      */
 121     if (SvCUR(sv))
 122         SvPOK_on(sv);
 123     EXTEND(sp,1);
 124     ST(0) = sv;
 125     XSRETURN(1);
 126 }
 127
 128 static
 129 XS(w32_GetLastError)
 130 {
 131         dXSARGS;
 132         XSRETURN_IV(GetLastError());
 133 }
 134
 135 XS(w32_IsWinNT)
 136 {
 137         dXSARGS;
 138         XSRETURN_IV(IsWinNT());
 139 }
 140
 141 XS(w32_IsWin95)
 142 {
 143         dXSARGS;
 144         XSRETURN_IV(IsWin95());
 145 }
 146
 147 static void
 148 xs_init()
 149 {
 150     char *file = __FILE__;
 151     dXSUB_SYS;
 152     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
 153     newXS("Win32::GetCurrentDirectory", w32_GetCurrentDirectory, file);
 154     newXS("Win32::GetLastError", w32_GetLastError, file);
 155     newXS("Win32::IsWinNT", w32_IsWinNT, file);
 156     newXS("Win32::IsWin95", w32_IsWin95, file);
 157 }
 158