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