Commit | Line | Data |
0a753a76 |
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" |
96e4d5b1 |
11 | #include "XSUB.h" |
0a753a76 |
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 | |
68dc0745 |
22 | __declspec(dllexport) int |
23 | RunPerl(int argc, char **argv, char **env, void *iosubsystem) |
0a753a76 |
24 | { |
68dc0745 |
25 | int exitstatus; |
26 | PerlInterpreter *my_perl; |
27 | void *pOldIOSubsystem; |
0a753a76 |
28 | |
68dc0745 |
29 | pOldIOSubsystem = SetIOSubSystem(iosubsystem); |
0a753a76 |
30 | |
31 | PERL_SYS_INIT(&argc,&argv); |
32 | |
33 | perl_init_i18nl10n(1); |
34 | |
68dc0745 |
35 | if (!(my_perl = perl_alloc())) |
36 | return (1); |
37 | perl_construct( my_perl ); |
38 | perl_destruct_level = 0; |
0a753a76 |
39 | |
40 | exitstatus = perl_parse( my_perl, xs_init, argc, argv, env); |
41 | if (!exitstatus) { |
42 | exitstatus = perl_run( my_perl ); |
43 | } |
44 | |
0a753a76 |
45 | perl_destruct( my_perl ); |
46 | perl_free( my_perl ); |
47 | |
48 | PERL_SYS_TERM(); |
49 | |
68dc0745 |
50 | SetIOSubSystem(pOldIOSubsystem); |
0a753a76 |
51 | |
68dc0745 |
52 | return (exitstatus); |
0a753a76 |
53 | } |
54 | |
0a753a76 |
55 | extern HANDLE PerlDllHandle; |
56 | |
68dc0745 |
57 | BOOL APIENTRY |
58 | DllMain(HANDLE hModule, /* DLL module handle */ |
59 | DWORD fdwReason, /* reason called */ |
60 | LPVOID lpvReserved) /* reserved */ |
0a753a76 |
61 | { |
68dc0745 |
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 */ |
0a753a76 |
68 | #ifdef DEFAULT_BINMODE |
68dc0745 |
69 | _setmode( _fileno( stdin ), _O_BINARY ); |
70 | _setmode( _fileno( stdout ), _O_BINARY ); |
71 | _setmode( _fileno( stderr ), _O_BINARY ); |
72 | _fmode = _O_BINARY; |
0a753a76 |
73 | #endif |
68dc0745 |
74 | PerlDllHandle = hModule; |
75 | break; |
0a753a76 |
76 | |
68dc0745 |
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; |
0a753a76 |
82 | |
68dc0745 |
83 | /* The attached process creates a new thread. */ |
84 | case DLL_THREAD_ATTACH: |
85 | break; |
0a753a76 |
86 | |
68dc0745 |
87 | /* The thread of the attached process terminates. */ |
88 | case DLL_THREAD_DETACH: |
89 | break; |
0a753a76 |
90 | |
68dc0745 |
91 | default: |
92 | break; |
93 | } |
94 | return TRUE; |
0a753a76 |
95 | } |
8b10511d |
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 | |