Mercurial > pidgin3 / file comparison

comparison: plugins/perl/perl.c

plugins/perl/perl.c

changeset 11290
136722ebf145
parent 11256
fe82a0c5e5ec
child 11318
13fa1d5134f3
equal deleted inserted replaced
11289:90e0133137e7 11290:136722ebf145
31 # undef DEBUG 31 # undef DEBUG
32 #endif 32 #endif
33 33
34 #undef PACKAGE 34 #undef PACKAGE
35 35
36
37 #define group perl_group 36 #define group perl_group
38 37
39 #ifdef _WIN32 38 #ifdef _WIN32
40 /* This took me an age to figure out.. without this __declspec(dllimport) 39 /* This took me an age to figure out.. without this __declspec(dllimport)
41 * will be ignored. 40 * will be ignored.
173 "return 0;" 172 "return 0;"
174 "}" 173 "}"
175 }; 174 };
176 175
177 my_perl = perl_alloc(); 176 my_perl = perl_alloc();
177 PERL_SET_CONTEXT(my_perl);
178 PL_perl_destruct_level = 1;
178 perl_construct(my_perl); 179 perl_construct(my_perl);
179 #ifdef DEBUG 180 #ifdef DEBUG
180 perl_parse(my_perl, xs_init, 4, perl_args, NULL); 181 perl_parse(my_perl, xs_init, 4, perl_args, NULL);
181 #else 182 #else
182 perl_parse(my_perl, xs_init, 3, perl_args, NULL); 183 perl_parse(my_perl, xs_init, 3, perl_args, NULL);
184 #ifdef HAVE_PERL_EVAL_PV 185 #ifdef HAVE_PERL_EVAL_PV
185 eval_pv(perl_definitions, TRUE); 186 eval_pv(perl_definitions, TRUE);
186 #else 187 #else
187 perl_eval_pv(perl_definitions, TRUE); /* deprecated */ 188 perl_eval_pv(perl_definitions, TRUE); /* deprecated */
188 #endif 189 #endif
189
190 perl_run(my_perl); 190 perl_run(my_perl);
191 } 191 }
192 192
193 static void 193 static void
194 perl_end(void) 194 perl_end(void)
195 { 195 {
196 if (my_perl == NULL) 196 if (my_perl == NULL)
197 return; 197 return;
198 198
199 PL_perl_destruct_level = 1;
200 PERL_SET_CONTEXT(my_perl);
199 perl_eval_pv( 201 perl_eval_pv(
200 "foreach my $lib (@DynaLoader::dl_modules) {" 202 "foreach my $lib (@DynaLoader::dl_modules) {"
201 "if ($lib =~ /^Gaim\\b/) {" 203 "if ($lib =~ /^Gaim\\b/) {"
202 "$lib .= '::deinit();';" 204 "$lib .= '::deinit();';"
203 "eval $lib;" 205 "eval $lib;"
204 "}" 206 "}"
205 "}", 207 "}",
206 TRUE); 208 TRUE);
207 209
210 PL_perl_destruct_level = 1;
211 PERL_SET_CONTEXT(my_perl);
208 perl_destruct(my_perl); 212 perl_destruct(my_perl);
209 perl_free(my_perl); 213 perl_free(my_perl);
210 my_perl = NULL; 214 my_perl = NULL;
211 } 215 }
212 216
224 static gboolean 228 static gboolean
225 probe_perl_plugin(GaimPlugin *plugin) 229 probe_perl_plugin(GaimPlugin *plugin)
226 { 230 {
227 /* XXX This would be much faster if I didn't create a new 231 /* XXX This would be much faster if I didn't create a new
228 * PerlInterpreter every time I probed a plugin */ 232 * PerlInterpreter every time I probed a plugin */
233
229 PerlInterpreter *prober = perl_alloc(); 234 PerlInterpreter *prober = perl_alloc();
230 char *argv[] = {"", plugin->path }; 235 char *argv[] = {"", plugin->path };
231 gboolean status = TRUE; 236 gboolean status = TRUE;
232 HV *plugin_info; 237 HV *plugin_info;
233 238 PERL_SET_CONTEXT(prober);
239 PL_perl_destruct_level = 1;
234 perl_construct(prober); 240 perl_construct(prober);
241
235 perl_parse(prober, xs_init, 2, argv, NULL); 242 perl_parse(prober, xs_init, 2, argv, NULL);
243
236 perl_run(prober); 244 perl_run(prober);
237 245
238 plugin_info = perl_get_hv("PLUGIN_INFO", FALSE); 246 plugin_info = perl_get_hv("PLUGIN_INFO", FALSE);
239 247
240 if (plugin_info == NULL) 248 if (plugin_info == NULL)
365 373
366 status = gaim_plugin_register(plugin); 374 status = gaim_plugin_register(plugin);
367 } 375 }
368 } 376 }
369 377
378 PL_perl_destruct_level = 1;
379 PERL_SET_CONTEXT(prober);
370 perl_destruct(prober); 380 perl_destruct(prober);
371 perl_free(prober); 381 perl_free(prober);
372
373 return status; 382 return status;
374 } 383 }
375 384
376 static gboolean 385 static gboolean
377 load_perl_plugin(GaimPlugin *plugin) 386 load_perl_plugin(GaimPlugin *plugin)
388 perl_init(); 397 perl_init();
389 398
390 plugin->handle = gps; 399 plugin->handle = gps;
391 400
392 atmp[1] = gps->package; 401 atmp[1] = gps->package;
393 402
403 PERL_SET_CONTEXT(my_perl);
394 execute_perl("Gaim::PerlLoader::load_n_eval", 2, atmp); 404 execute_perl("Gaim::PerlLoader::load_n_eval", 2, atmp);
395 405
396 { 406 {
407 PERL_SET_CONTEXT(my_perl);
397 dSP; 408 dSP;
398 ENTER; 409 ENTER;
399 SAVETMPS; 410 SAVETMPS;
400 PUSHMARK(sp); 411 PUSHMARK(sp);
401 XPUSHs(sv_2mortal(gaim_perl_bless_object(plugin, "Gaim::Plugin"))); 412 XPUSHs(sv_2mortal(gaim_perl_bless_object(plugin, "Gaim::Plugin")));
421 } 432 }
422 433
423 static void 434 static void
424 destroy_package(const char *package) 435 destroy_package(const char *package)
425 { 436 {
437 PERL_SET_CONTEXT(my_perl);
426 dSP; 438 dSP;
427 439
428 ENTER; 440 ENTER;
429 SAVETMPS; 441 SAVETMPS;
430 442
452 464
453 gaim_debug(GAIM_DEBUG_INFO, "perl", "Unloading perl script\n"); 465 gaim_debug(GAIM_DEBUG_INFO, "perl", "Unloading perl script\n");
454 466
455 if (gps->unload_sub != NULL) 467 if (gps->unload_sub != NULL)
456 { 468 {
469 PERL_SET_CONTEXT(my_perl);
457 dSP; 470 dSP;
458 ENTER; 471 ENTER;
459 SAVETMPS; 472 SAVETMPS;
460 PUSHMARK(sp); 473 PUSHMARK(sp);
461 XPUSHs(sv_2mortal(gaim_perl_bless_object(plugin, "Gaim::Plugin"))); 474 XPUSHs(sv_2mortal(gaim_perl_bless_object(plugin, "Gaim::Plugin")));

Mercurial Repository: pidgin3

mercurial