extra code in pp_concat, Take 2
[p5sagit/p5-mst-13.2.git] / NetWare / interface.c
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
32 ClsPerlHost::ClsPerlHost()
33 {
34
35 }
36
37 ClsPerlHost::~ClsPerlHost()
38 {
39
40 }
41
42 ClsPerlHost::VersionNumber()
43 {
44         return 0;
45 }
46
47 bool
48 ClsPerlHost::RegisterWithThreadTable()
49 {
50         return(fnRegisterWithThreadTable());
51 }
52
53 bool
54 ClsPerlHost::UnregisterWithThreadTable()
55 {
56         return(fnUnregisterWithThreadTable());
57 }
58
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);
65
66         return 1;
67 }
68
69 int
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
76 ClsPerlHost::PerlRun(PerlInterpreter *my_perl)
77 {
78         return(perl_run(my_perl));      // Run Perl.
79 }
80
81 void
82 ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)
83 {
84         perl_destruct(my_perl);         // Destructor for Perl.
85 }
86
87 void
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
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
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(var,type)
130                 #define PERLVARA(var,type)
131                 #define PERLVARI(var,type,init) PL_Vars.var = init;
132                 #define PERLVARIC(var,type,init) PL_Vars.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                 exitstatus = nlm.PerlParse(my_perl, argc, argv, env);
152                 if(exitstatus == 0)
153                 {
154                         #if defined(TOP_CLONE) && defined(USE_ITHREADS)         // XXXXXX testing
155                                 new_perl = perl_clone(my_perl, 1);
156
157                                 exitstatus = perl_run(new_perl);        // Run Perl.
158                                 PERL_SET_THX(my_perl);
159                         #else
160                                 exitstatus = nlm.PerlRun(my_perl);
161                         #endif
162                 }
163                 nlm.PerlDestroy(my_perl);
164         }
165         if(my_perl)
166                 nlm.PerlFree(my_perl);
167
168         #ifdef USE_ITHREADS
169                 if (new_perl)
170                 {
171                         PERL_SET_THX(new_perl);
172                         nlm.PerlDestroy(new_perl);
173                         nlm.PerlFree(my_perl);
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 {
191         return (IPerlHost*) new ClsPerlHost();
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 {
203         if (pPerlHost)
204                 delete (ClsPerlHost*) pPerlHost;
205 }
206