Integrate mainline
[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 (pTHXo_ CV* cv);
28
29
30 ClsPerlHost::ClsPerlHost()
31 {
32
33 }
34
35 ClsPerlHost::~ClsPerlHost()
36 {
37
38 }
39
40 ClsPerlHost::VersionNumber()
41 {
42         return 0;
43 }
44
45 bool
46 ClsPerlHost::RegisterWithThreadTable()
47 {
48         return(fnRegisterWithThreadTable());
49 }
50
51 bool
52 ClsPerlHost::UnregisterWithThreadTable()
53 {
54         return(fnUnregisterWithThreadTable());
55 }
56
57 int
58 ClsPerlHost::PerlCreate(PerlInterpreter *my_perl)
59 {
60 /*      if (!(my_perl = perl_alloc()))          // Allocate memory for Perl.
61                 return (1);*/
62     perl_construct(my_perl);
63
64         return 1;
65 }
66
67 int
68 ClsPerlHost::PerlParse(PerlInterpreter *my_perl, int argc, char** argv, char** env)
69 {
70         return(perl_parse(my_perl, xs_init, argc, argv, env));          // Parse the command line.
71 }
72
73 int
74 ClsPerlHost::PerlRun(PerlInterpreter *my_perl)
75 {
76         return(perl_run(my_perl));      // Run Perl.
77 }
78
79 void
80 ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)
81 {
82         perl_destruct(my_perl);         // Destructor for Perl.
83         perl_free(my_perl);                     // Free the memory allocated for Perl.
84
85 }
86
87 /*============================================================================================
88
89  Function               :       xs_init
90
91  Description    :       
92
93  Parameters     :       pTHX    (IN)    -       
94
95  Returns                :       Nothing.
96
97 ==============================================================================================*/
98
99 static void xs_init(pTHX)
100 {
101         char *file = __FILE__;
102
103         dXSUB_SYS;
104         newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
105 }
106
107
108 EXTERN_C
109 int RunPerl(int argc, char **argv, char **env)
110 {
111         int exitstatus = 0;
112         ClsPerlHost nlm;
113
114         PerlInterpreter *my_perl = NULL;                // defined in Perl.h
115         PerlInterpreter *new_perl = NULL;               // defined in Perl.h
116
117         #ifdef PERL_GLOBAL_STRUCT
118                 #define PERLVAR(var,type)
119                 #define PERLVARA(var,type)
120                 #define PERLVARI(var,type,init) PL_Vars.var = init;
121                 #define PERLVARIC(var,type,init) PL_Vars.var = init;
122
123                 #include "perlvars.h"
124
125                 #undef PERLVAR
126                 #undef PERLVARA
127                 #undef PERLVARI
128                 #undef PERLVARIC
129         #endif
130
131         PERL_SYS_INIT(&argc, &argv);
132
133         if (!(my_perl = perl_alloc()))          // Allocate memory for Perl.
134                 return (1);
135
136         if(nlm.PerlCreate(my_perl))
137         {
138                 PL_perl_destruct_level = 0;
139
140                 exitstatus = nlm.PerlParse(my_perl, argc, argv, env);
141                 if(exitstatus == 0)
142                 {
143                         #if defined(TOP_CLONE) && defined(USE_ITHREADS)         // XXXXXX testing
144                                 #  ifdef PERL_OBJECT
145                                         CPerlHost *h = new CPerlHost();
146                                         new_perl = perl_clone_using(my_perl, 1,
147                                                                                 h->m_pHostperlMem,
148                                                                                 h->m_pHostperlMemShared,
149                                                                                 h->m_pHostperlMemParse,
150                                                                                 h->m_pHostperlEnv,
151                                                                                 h->m_pHostperlStdIO,
152                                                                                 h->m_pHostperlLIO,
153                                                                                 h->m_pHostperlDir,
154                                                                                 h->m_pHostperlSock,
155                                                                                 h->m_pHostperlProc
156                                                                                 );
157                                         CPerlObj *pPerl = (CPerlObj*)new_perl;
158                                 #  else
159                                         new_perl = perl_clone(my_perl, 1);
160                                 #  endif
161
162                                 exitstatus = perl_run(new_perl);        // Run Perl.
163                                 PERL_SET_THX(my_perl);
164                         #else
165                                 exitstatus = nlm.PerlRun(my_perl);
166                         #endif
167                 }
168                 nlm.PerlDestroy(my_perl);
169         }
170
171         #ifdef USE_ITHREADS
172                 if (new_perl)
173                 {
174                         PERL_SET_THX(new_perl);
175                         nlm.PerlDestroy(new_perl);
176                 }
177         #endif
178
179         PERL_SYS_TERM();
180         return exitstatus;
181 }
182
183
184 // FUNCTION: AllocStdPerl
185 //
186 // DESCRIPTION:
187 //      Allocates a standard perl handler that other perl handlers
188 //      may delegate to. You should call FreeStdPerl to free this
189 //      instance when you are done with it.
190 //
191 IPerlHost* AllocStdPerl()
192 {
193         return new ClsPerlHost();
194 }
195
196
197 // FUNCTION: FreeStdPerl
198 //
199 // DESCRIPTION:
200 //      Frees an instance of a standard perl handler allocated by
201 //      AllocStdPerl.
202 //
203 void FreeStdPerl(IPerlHost* pPerlHost)
204 {
205         delete (ClsPerlHost*) pPerlHost;
206 }
207
208