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