Commit | Line | Data |
---|---|---|
12232b79 JH |
1 | |
2 | /* | |
cdad3b53 | 3 | * Copyright © 2001 Novell, Inc. All Rights Reserved. |
12232b79 JH |
4 | * |
5 | * You may distribute under the terms of either the GNU General Public | |
6 | * License or the Artistic License, as specified in the README file. | |
7 | * | |
8 | */ | |
9 | ||
10 | /* | |
11 | * FILENAME : interface.c | |
12 | * DESCRIPTION : Perl parsing and running functions. | |
13 | * Author : SGP | |
14 | * Date : January 2001. | |
15 | * | |
16 | */ | |
17 | ||
18 | ||
19 | ||
20 | #include "interface.h" | |
21 | ||
22 | #include "win32ish.h" // For "BOOL", "TRUE" and "FALSE" | |
23 | ||
24 | ||
25 | static void xs_init(pTHX); | |
26 | //static void xs_init(pTHXo); //(J) | |
27 | ||
28 | EXTERN_C int RunPerl(int argc, char **argv, char **env); | |
29 | EXTERN_C void Perl_nw5_init(int *argcp, char ***argvp); | |
30 | EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); // (J) pTHXo_ | |
31 | ||
32 | EXTERN_C BOOL Remove_Thread_Ctx(void); | |
33 | ||
34 | ||
35 | ClsPerlHost::ClsPerlHost() | |
36 | { | |
37 | ||
38 | } | |
39 | ||
40 | ClsPerlHost::~ClsPerlHost() | |
41 | { | |
42 | ||
43 | } | |
44 | ||
45 | ClsPerlHost::VersionNumber() | |
46 | { | |
47 | return 0; | |
48 | } | |
49 | ||
50 | int | |
51 | ClsPerlHost::PerlCreate(PerlInterpreter *my_perl) | |
52 | { | |
53 | /* if (!(my_perl = perl_alloc())) // Allocate memory for Perl. | |
54 | return (1);*/ | |
55 | perl_construct(my_perl); | |
8e920bd3 | 56 | PL_exit_flags |= PERL_EXIT_DESTRUCT_END; |
12232b79 JH |
57 | |
58 | return 1; | |
59 | } | |
60 | ||
61 | int | |
62 | ClsPerlHost::PerlParse(PerlInterpreter *my_perl, int argc, char** argv, char** env) | |
63 | { | |
64 | return(perl_parse(my_perl, xs_init, argc, argv, env)); // Parse the command line. | |
65 | } | |
66 | ||
67 | int | |
68 | ClsPerlHost::PerlRun(PerlInterpreter *my_perl) | |
69 | { | |
70 | return(perl_run(my_perl)); // Run Perl. | |
71 | } | |
72 | ||
fe2024f9 | 73 | int |
12232b79 JH |
74 | ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl) |
75 | { | |
fe2024f9 | 76 | int ret = perl_destruct(my_perl); // Destructor for Perl. |
12232b79 | 77 | //// perl_free(my_perl); // Free the memory allocated for Perl. |
fe2024f9 | 78 | return(ret); |
12232b79 JH |
79 | } |
80 | ||
81 | void | |
82 | ClsPerlHost::PerlFree(PerlInterpreter *my_perl) | |
83 | { | |
84 | perl_free(my_perl); // Free the memory allocated for Perl. | |
85 | ||
86 | // Remove the thread context set during Perl_set_context | |
87 | // This is added here since for web script there is no other place this gets executed | |
88 | // and it cannot be included into cgi2perl.xs unless this symbol is exported. | |
89 | Remove_Thread_Ctx(); | |
90 | } | |
91 | ||
92 | /*============================================================================================ | |
93 | ||
94 | Function : xs_init | |
95 | ||
96 | Description : | |
97 | ||
98 | Parameters : pTHX (IN) - | |
99 | ||
100 | Returns : Nothing. | |
101 | ||
102 | ==============================================================================================*/ | |
103 | ||
104 | static void xs_init(pTHX) | |
105 | //static void xs_init(pTHXo) //J | |
106 | { | |
107 | char *file = __FILE__; | |
108 | ||
109 | dXSUB_SYS; | |
110 | newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); | |
111 | } | |
112 | ||
113 | ||
114 | EXTERN_C | |
115 | int RunPerl(int argc, char **argv, char **env) | |
116 | { | |
117 | int exitstatus = 0; | |
118 | ClsPerlHost nlm; | |
119 | ||
120 | PerlInterpreter *my_perl = NULL; // defined in Perl.h | |
121 | PerlInterpreter *new_perl = NULL; // defined in Perl.h | |
122 | ||
123 | //__asm{int 3}; | |
124 | #ifdef PERL_GLOBAL_STRUCT | |
115ff745 NC |
125 | #define PERLVAR(prefix,var,type) |
126 | #define PERLVARA(prefix,var,type) | |
127 | #define PERLVARI(prefix,var,type,init) PL_Vars.prefix##var = init; | |
128 | #define PERLVARIC(prefix,var,type,init) PL_Vars.prefix##var = init; | |
12232b79 JH |
129 | |
130 | #include "perlvars.h" | |
131 | ||
132 | #undef PERLVAR | |
133 | #undef PERLVARA | |
134 | #undef PERLVARI | |
135 | #undef PERLVARIC | |
136 | #endif | |
137 | ||
138 | PERL_SYS_INIT(&argc, &argv); | |
139 | ||
140 | if (!(my_perl = perl_alloc())) // Allocate memory for Perl. | |
141 | return (1); | |
142 | ||
143 | if(nlm.PerlCreate(my_perl)) | |
144 | { | |
145 | PL_perl_destruct_level = 0; | |
146 | ||
fe2024f9 | 147 | if(!nlm.PerlParse(my_perl, argc, argv, env)) |
12232b79 JH |
148 | { |
149 | #if defined(TOP_CLONE) && defined(USE_ITHREADS) // XXXXXX testing | |
150 | # ifdef PERL_OBJECT | |
151 | CPerlHost *h = new CPerlHost(); | |
152 | new_perl = perl_clone_using(my_perl, 1, | |
153 | h->m_pHostperlMem, | |
154 | h->m_pHostperlMemShared, | |
155 | h->m_pHostperlMemParse, | |
156 | h->m_pHostperlEnv, | |
157 | h->m_pHostperlStdIO, | |
158 | h->m_pHostperlLIO, | |
159 | h->m_pHostperlDir, | |
160 | h->m_pHostperlSock, | |
161 | h->m_pHostperlProc | |
162 | ); | |
163 | CPerlObj *pPerl = (CPerlObj*)new_perl; | |
164 | # else | |
165 | new_perl = perl_clone(my_perl, 1); | |
166 | # endif | |
167 | ||
fe2024f9 | 168 | (void) perl_run(new_perl); // Run Perl. |
12232b79 JH |
169 | PERL_SET_THX(my_perl); |
170 | #else | |
fe2024f9 | 171 | (void) nlm.PerlRun(my_perl); |
12232b79 JH |
172 | #endif |
173 | } | |
fe2024f9 | 174 | exitstatus = nlm.PerlDestroy(my_perl); |
12232b79 JH |
175 | } |
176 | if(my_perl) | |
177 | nlm.PerlFree(my_perl); | |
178 | ||
179 | #ifdef USE_ITHREADS | |
180 | if (new_perl) | |
181 | { | |
182 | PERL_SET_THX(new_perl); | |
fe2024f9 | 183 | exitstatus = nlm.PerlDestroy(new_perl); |
12232b79 JH |
184 | nlm.PerlFree(my_perl); |
185 | } | |
186 | #endif | |
187 | ||
188 | PERL_SYS_TERM(); | |
189 | return exitstatus; | |
190 | } | |
191 | ||
192 | ||
193 | // FUNCTION: AllocStdPerl | |
194 | // | |
195 | // DESCRIPTION: | |
196 | // Allocates a standard perl handler that other perl handlers | |
197 | // may delegate to. You should call FreeStdPerl to free this | |
198 | // instance when you are done with it. | |
199 | // | |
200 | IPerlHost* AllocStdPerl() | |
201 | { | |
202 | return (IPerlHost*) new ClsPerlHost(); | |
203 | } | |
204 | ||
205 | ||
206 | // FUNCTION: FreeStdPerl | |
207 | // | |
208 | // DESCRIPTION: | |
209 | // Frees an instance of a standard perl handler allocated by | |
210 | // AllocStdPerl. | |
211 | // | |
212 | void FreeStdPerl(IPerlHost* pPerlHost) | |
213 | { | |
214 | if (pPerlHost) | |
215 | delete (ClsPerlHost*) pPerlHost; | |
216 | //// delete pPerlHost; | |
217 | } | |
218 |