Commit | Line | Data |
76e3520e |
1 | |
2 | #ifdef PERL_OBJECT |
3 | #define USE_SOCKETS_AS_HANDLES |
4 | #include "EXTERN.h" |
5 | #include "perl.h" |
6 | |
565764a8 |
7 | #define NO_XSLOCKS |
76e3520e |
8 | #include "XSUB.H" |
565764a8 |
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 |
76e3520e |
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 | |
9d8a25dc |
177 | EXTERN_C void boot_DynaLoader _((CPERLarg_ CV* cv)) |
178 | { |
179 | } |
180 | |
76e3520e |
181 | #else /* PERL_OBJECT */ |
182 | |
390b85e7 |
183 | /* Say NO to CPP! Hallelujah! */ |
a835ef8a |
184 | #ifdef __GNUC__ |
5b0d9cbe |
185 | /* |
186 | * GNU C does not do __declspec() |
187 | */ |
a835ef8a |
188 | #define __declspec(foo) |
5b0d9cbe |
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 | |
a835ef8a |
197 | #endif |
0a753a76 |
198 | |
5b0d9cbe |
199 | |
390b85e7 |
200 | __declspec(dllimport) int RunPerl(int argc, char **argv, char **env, void *ios); |
0a753a76 |
201 | |
137443ea |
202 | int |
0a753a76 |
203 | main(int argc, char **argv, char **env) |
204 | { |
390b85e7 |
205 | return RunPerl(argc, argv, env, (void*)0); |
0a753a76 |
206 | } |
76e3520e |
207 | |
208 | #endif /* PERL_OBJECT */ |