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