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