Mercurial > pidgin.yaz
comparison plugins/perl/perl.c @ 6520:2e2593d95121
[gaim-migrate @ 7037]
Added timeout handler support to perl. It may not work. Probably should,
but who knows.
committer: Tailor Script <tailor@pidgin.im>
author | Christian Hammond <chipx86@chipx86.com> |
---|---|
date | Wed, 20 Aug 2003 10:25:58 +0000 |
parents | cbd24b37350d |
children | 0c5233faceb8 |
comparison
equal
deleted
inserted
replaced
6519:7f0fffa1077b | 6520:2e2593d95121 |
---|---|
159 #endif | 159 #endif |
160 | 160 |
161 perl_run(my_perl); | 161 perl_run(my_perl); |
162 } | 162 } |
163 | 163 |
164 /* | |
165 2003/02/06: execute_perl modified by Mark Doliner <mark@kingant.net> | |
166 Pass parameters by pushing them onto the stack rather than | |
167 passing an array of strings. This way, perl scripts can | |
168 modify the parameters and we can get the changed values | |
169 and then shoot ourselves. I mean, uh, use them. | |
170 | |
171 2001/06/14: execute_perl replaced by Martin Persson <mep@passagen.se> | |
172 previous use of perl_eval leaked memory, replaced with | |
173 a version that uses perl_call instead | |
174 | |
175 30/11/2002: execute_perl modified by Eric Timme <timothy@voidnet.com> | |
176 args changed to char** so that we can have preparsed | |
177 arguments again, and many headaches ensued! This essentially | |
178 means we replaced one hacked method with a messier hacked | |
179 method out of perceived necessity. Formerly execute_perl | |
180 required a single char_ptr, and it would insert it into an | |
181 array of character pointers and NULL terminate the new array. | |
182 Now we have to pass in pre-terminated character pointer arrays | |
183 to accomodate functions that want to pass in multiple arguments. | |
184 | |
185 Previously arguments were preparsed because an argument list | |
186 was constructed in the form 'arg one','arg two' and was | |
187 executed via a call like &funcname(arglist) (see .59.x), so | |
188 the arglist was magically pre-parsed because of the method. | |
189 With Martin Persson's change to perl_call we now need to | |
190 use a null terminated list of character pointers for arguments | |
191 if we wish them to be parsed. Lacking a better way to allow | |
192 for both single arguments and many I created a NULL terminated | |
193 array in every function that called execute_perl and passed | |
194 that list into the function. In the former version a single | |
195 character pointer was passed in, and was placed into an array | |
196 of character pointers with two elements, with a NULL element | |
197 tacked onto the back, but this method no longer seemed prudent. | |
198 | |
199 Enhancements in the future might be to get rid of pre-declaring | |
200 the array sizes? I am not comfortable enough with this | |
201 subject to attempt it myself and hope it to stand the test | |
202 of time. | |
203 */ | |
204 | |
205 static int | |
206 execute_perl(const char *function, int argc, char **args) | |
207 { | |
208 int count = 0, i, ret_value = 1; | |
209 SV *sv_args[argc]; | |
210 STRLEN na; | |
211 | |
212 /* | |
213 * Set up the perl environment, push arguments onto the | |
214 * perl stack, then call the given function | |
215 */ | |
216 dSP; | |
217 ENTER; | |
218 SAVETMPS; | |
219 PUSHMARK(sp); | |
220 | |
221 for (i = 0; i < argc; i++) { | |
222 if (args[i]) { | |
223 sv_args[i] = sv_2mortal(newSVpv(args[i], 0)); | |
224 XPUSHs(sv_args[i]); | |
225 } | |
226 } | |
227 | |
228 PUTBACK; | |
229 count = call_pv(function, G_EVAL | G_SCALAR); | |
230 SPAGAIN; | |
231 | |
232 /* | |
233 * Check for "die," make sure we have 1 argument, and set our | |
234 * return value. | |
235 */ | |
236 if (SvTRUE(ERRSV)) { | |
237 gaim_debug(GAIM_DEBUG_ERROR, "perl", | |
238 "Perl function %s exited abnormally: %s\n", | |
239 function, SvPV(ERRSV, na)); | |
240 POPs; | |
241 } | |
242 else if (count != 1) { | |
243 /* | |
244 * This should NEVER happen. G_SCALAR ensures that we WILL | |
245 * have 1 parameter. | |
246 */ | |
247 gaim_debug(GAIM_DEBUG_ERROR, "perl", | |
248 "Perl error from %s: expected 1 return value, " | |
249 "but got %d\n", function, count); | |
250 } | |
251 else | |
252 ret_value = POPi; | |
253 | |
254 /* Check for changed arguments */ | |
255 for (i = 0; i < argc; i++) { | |
256 if (args[i] && strcmp(args[i], SvPVX(sv_args[i]))) { | |
257 /* | |
258 * Shizzel. So the perl script changed one of the parameters, | |
259 * and we want this change to affect the original parameters. | |
260 * args[i] is just a tempory little list of pointers. We don't | |
261 * want to free args[i] here because the new parameter doesn't | |
262 * overwrite the data that args[i] points to. That is done by | |
263 * the function that called execute_perl. I'm not explaining this | |
264 * very well. See, it's aggregate... Oh, but if 2 perl scripts | |
265 * both modify the data, _that's_ a memleak. This is really kind | |
266 * of hackish. I should fix it. Look how long this comment is. | |
267 * Holy crap. | |
268 */ | |
269 args[i] = g_strdup(SvPV(sv_args[i], na)); | |
270 } | |
271 } | |
272 | |
273 PUTBACK; | |
274 FREETMPS; | |
275 LEAVE; | |
276 | |
277 return ret_value; | |
278 } | |
279 | |
280 static void | 164 static void |
281 perl_end(void) | 165 perl_end(void) |
282 { | 166 { |
283 if (my_perl != NULL) { | 167 if (my_perl == NULL) |
284 perl_destruct(my_perl); | 168 return; |
285 perl_free(my_perl); | 169 |
286 my_perl = NULL; | 170 perl_eval_pv( |
287 } | 171 "foreach my $lib (@DynaLoader::dl_modules) {" |
172 "if ($lib =~ /^Gaim\\b/) {" | |
173 "$lib .= '::deinit();';" | |
174 "eval $lib;" | |
175 "}" | |
176 "}", | |
177 TRUE); | |
178 | |
179 perl_destruct(my_perl); | |
180 perl_free(my_perl); | |
181 my_perl = NULL; | |
288 } | 182 } |
289 | 183 |
290 void | 184 void |
291 gaim_perl_callXS(void (*subaddr)(pTHX_ CV *cv), CV *cv, SV **mark) | 185 gaim_perl_callXS(void (*subaddr)(pTHX_ CV *cv), CV *cv, SV **mark) |
292 { | 186 { |