Mercurial > pidgin.yaz

comparison libpurple/plugins/perl/perl.c @ 15823:32c366eeeb99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sed -ie 's/gaim/purple/g'
author Sean Egan <seanegan@gmail.com>
date Mon, 19 Mar 2007 07:01:17 +0000
parents 5fe8042783c1
children a5a64fcad0ca
comparison
equal deleted inserted replaced
15822:84b0f9b23ede 15823:32c366eeeb99
1 /* 1 /*
2 * gaim 2 * purple
3 * 3 *
4 * Copyright (C) 2003 Christian Hammond <chipx86@gnupdate.org> 4 * Copyright (C) 2003 Christian Hammond <chipx86@gnupdate.org>
5 * 5 *
6 * This program is free software; you can redistribute it and/or modify 6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by 7 * it under the terms of the GNU General Public License as published by
95 95
96 #define PERL_PLUGIN_ID "core-perl" 96 #define PERL_PLUGIN_ID "core-perl"
97 97
98 PerlInterpreter *my_perl = NULL; 98 PerlInterpreter *my_perl = NULL;
99 99
100 static GaimPluginUiInfo ui_info = 100 static PurplePluginUiInfo ui_info =
101 { 101 {
102 gaim_perl_get_plugin_frame, 102 purple_perl_get_plugin_frame,
103 0, /* page_num (Reserved) */ 103 0, /* page_num (Reserved) */
104 NULL /* frame (Reserved) */ 104 NULL /* frame (Reserved) */
105 }; 105 };
106 106
107 #ifdef GAIM_GTKPERL 107 #ifdef PURPLE_GTKPERL
108 static GaimGtkPluginUiInfo gtk_ui_info = 108 static PurpleGtkPluginUiInfo gtk_ui_info =
109 { 109 {
110 gaim_perl_gtk_get_plugin_frame, 110 purple_perl_gtk_get_plugin_frame,
111 0 /* page_num (Reserved) */ 111 0 /* page_num (Reserved) */
112 }; 112 };
113 #endif 113 #endif
114 114
115 static void 115 static void
139 /* We use to function one to load a file the other to execute 139 /* We use to function one to load a file the other to execute
140 * the string obtained from the first and holding the file 140 * the string obtained from the first and holding the file
141 * contents. This allows to have a really local $/ without 141 * contents. This allows to have a really local $/ without
142 * introducing temp variables to hold the old value. Just a 142 * introducing temp variables to hold the old value. Just a
143 * question of style:) */ 143 * question of style:) */
144 "package Gaim::PerlLoader;" 144 "package Purple::PerlLoader;"
145 "use Symbol;" 145 "use Symbol;"
146 146
147 "sub load_file {" 147 "sub load_file {"
148 "my $f_name=shift;" 148 "my $f_name=shift;"
149 "local $/=undef;" 149 "local $/=undef;"
203 203
204 PL_perl_destruct_level = 1; 204 PL_perl_destruct_level = 1;
205 PERL_SET_CONTEXT(my_perl); 205 PERL_SET_CONTEXT(my_perl);
206 perl_eval_pv( 206 perl_eval_pv(
207 "foreach my $lib (@DynaLoader::dl_modules) {" 207 "foreach my $lib (@DynaLoader::dl_modules) {"
208 "if ($lib =~ /^Gaim\\b/) {" 208 "if ($lib =~ /^Purple\\b/) {"
209 "$lib .= '::deinit();';" 209 "$lib .= '::deinit();';"
210 "eval $lib;" 210 "eval $lib;"
211 "}" 211 "}"
212 "}", 212 "}",
213 TRUE); 213 TRUE);
218 perl_free(my_perl); 218 perl_free(my_perl);
219 my_perl = NULL; 219 my_perl = NULL;
220 } 220 }
221 221
222 void 222 void
223 gaim_perl_callXS(void (*subaddr)(pTHX_ CV *cv), CV *cv, SV **mark) 223 purple_perl_callXS(void (*subaddr)(pTHX_ CV *cv), CV *cv, SV **mark)
224 { 224 {
225 dSP; 225 dSP;
226 226
227 PUSHMARK(mark); 227 PUSHMARK(mark);
228 (*subaddr)(aTHX_ cv); 228 (*subaddr)(aTHX_ cv);
229 229
230 PUTBACK; 230 PUTBACK;
231 } 231 }
232 232
233 static gboolean 233 static gboolean
234 probe_perl_plugin(GaimPlugin *plugin) 234 probe_perl_plugin(PurplePlugin *plugin)
235 { 235 {
236 /* XXX This would be much faster if I didn't create a new 236 /* XXX This would be much faster if I didn't create a new
237 * PerlInterpreter every time I probed a plugin */ 237 * PerlInterpreter every time I probed a plugin */
238 238
239 PerlInterpreter *prober = perl_alloc(); 239 PerlInterpreter *prober = perl_alloc();
269 perl_api_ver = SvIV(*key); 269 perl_api_ver = SvIV(*key);
270 270
271 if (perl_api_ver != 2) 271 if (perl_api_ver != 2)
272 status = FALSE; 272 status = FALSE;
273 else { 273 else {
274 GaimPluginInfo *info; 274 PurplePluginInfo *info;
275 GaimPerlScript *gps; 275 PurplePerlScript *gps;
276 char *basename; 276 char *basename;
277 STRLEN len; 277 STRLEN len;
278 278
279 info = g_new0(GaimPluginInfo, 1); 279 info = g_new0(PurplePluginInfo, 1);
280 gps = g_new0(GaimPerlScript, 1); 280 gps = g_new0(PurplePerlScript, 1);
281 281
282 info->magic = GAIM_PLUGIN_MAGIC; 282 info->magic = PURPLE_PLUGIN_MAGIC;
283 info->major_version = GAIM_MAJOR_VERSION; 283 info->major_version = PURPLE_MAJOR_VERSION;
284 info->minor_version = GAIM_MINOR_VERSION; 284 info->minor_version = PURPLE_MINOR_VERSION;
285 info->type = GAIM_PLUGIN_STANDARD; 285 info->type = PURPLE_PLUGIN_STANDARD;
286 286
287 info->dependencies = g_list_append(info->dependencies, 287 info->dependencies = g_list_append(info->dependencies,
288 PERL_PLUGIN_ID); 288 PERL_PLUGIN_ID);
289 289
290 gps->plugin = plugin; 290 gps->plugin = plugin;
291 291
292 basename = g_path_get_basename(plugin->path); 292 basename = g_path_get_basename(plugin->path);
293 gaim_perl_normalize_script_name(basename); 293 purple_perl_normalize_script_name(basename);
294 gps->package = g_strdup_printf("Gaim::Script::%s", 294 gps->package = g_strdup_printf("Purple::Script::%s",
295 basename); 295 basename);
296 g_free(basename); 296 g_free(basename);
297 297
298 /* We know this one exists. */ 298 /* We know this one exists. */
299 key = hv_fetch(plugin_info, "name", strlen("name"), 0); 299 key = hv_fetch(plugin_info, "name", strlen("name"), 0);
300 info->name = g_strdup(SvPV(*key, len)); 300 info->name = g_strdup(SvPV(*key, len));
301 /* Set id here in case we don't find one later. */ 301 /* Set id here in case we don't find one later. */
302 info->id = g_strdup(SvPV(*key, len)); 302 info->id = g_strdup(SvPV(*key, len));
303 303
304 #ifdef GAIM_GTKPERL 304 #ifdef PURPLE_GTKPERL
305 if ((key = hv_fetch(plugin_info, "GTK_UI", 305 if ((key = hv_fetch(plugin_info, "GTK_UI",
306 strlen("GTK_UI"), 0))) 306 strlen("GTK_UI"), 0)))
307 info->ui_requirement = GAIM_GTK_PLUGIN_TYPE; 307 info->ui_requirement = PURPLE_GTK_PLUGIN_TYPE;
308 #endif 308 #endif
309 309
310 if ((key = hv_fetch(plugin_info, "url", 310 if ((key = hv_fetch(plugin_info, "url",
311 strlen("url"), 0))) 311 strlen("url"), 0)))
312 info->homepage = g_strdup(SvPV(*key, len)); 312 info->homepage = g_strdup(SvPV(*key, len));
346 } 346 }
347 347
348 /********************************************************/ 348 /********************************************************/
349 /* Only one of the next two options should be present */ 349 /* Only one of the next two options should be present */
350 /* */ 350 /* */
351 /* prefs_info - Uses non-GUI (read GTK) gaim API calls */ 351 /* prefs_info - Uses non-GUI (read GTK) purple API calls */
352 /* and creates a GaimPluginPrefInfo type. */ 352 /* and creates a PurplePluginPrefInfo type. */
353 /* */ 353 /* */
354 /* gtk_prefs_info - Requires gtk2-perl be installed by */ 354 /* gtk_prefs_info - Requires gtk2-perl be installed by */
355 /* the user and he must create a */ 355 /* the user and he must create a */
356 /* GtkWidget the user and he must */ 356 /* GtkWidget the user and he must */
357 /* create a GtkWidget representing the */ 357 /* create a GtkWidget representing the */
365 gps->package, 365 gps->package,
366 SvPV(*key, len)); 366 SvPV(*key, len));
367 info->prefs_info = &ui_info; 367 info->prefs_info = &ui_info;
368 } 368 }
369 369
370 #ifdef GAIM_GTKPERL 370 #ifdef PURPLE_GTKPERL
371 if ((key = hv_fetch(plugin_info, "gtk_prefs_info", 371 if ((key = hv_fetch(plugin_info, "gtk_prefs_info",
372 strlen("gtk_prefs_info"), 0))) { 372 strlen("gtk_prefs_info"), 0))) {
373 /* key now is the name of the Perl sub that 373 /* key now is the name of the Perl sub that
374 * will create a frame for us */ 374 * will create a frame for us */
375 gps->gtk_prefs_sub = g_strdup_printf("%s::%s", 375 gps->gtk_prefs_sub = g_strdup_printf("%s::%s",
382 if ((key = hv_fetch(plugin_info, "plugin_action_sub", 382 if ((key = hv_fetch(plugin_info, "plugin_action_sub",
383 strlen("plugin_action_sub"), 0))) { 383 strlen("plugin_action_sub"), 0))) {
384 gps->plugin_action_sub = g_strdup_printf("%s::%s", 384 gps->plugin_action_sub = g_strdup_printf("%s::%s",
385 gps->package, 385 gps->package,
386 SvPV(*key, len)); 386 SvPV(*key, len));
387 info->actions = gaim_perl_plugin_actions; 387 info->actions = purple_perl_plugin_actions;
388 } 388 }
389 389
390 plugin->info = info; 390 plugin->info = info;
391 info->extra_info = gps; 391 info->extra_info = gps;
392 392
393 status = gaim_plugin_register(plugin); 393 status = purple_plugin_register(plugin);
394 } 394 }
395 } 395 }
396 396
397 PL_perl_destruct_level = 1; 397 PL_perl_destruct_level = 1;
398 PERL_SET_CONTEXT(prober); 398 PERL_SET_CONTEXT(prober);
400 perl_free(prober); 400 perl_free(prober);
401 return status; 401 return status;
402 } 402 }
403 403
404 static gboolean 404 static gboolean
405 load_perl_plugin(GaimPlugin *plugin) 405 load_perl_plugin(PurplePlugin *plugin)
406 { 406 {
407 GaimPerlScript *gps = (GaimPerlScript *)plugin->info->extra_info; 407 PurplePerlScript *gps = (PurplePerlScript *)plugin->info->extra_info;
408 char *atmp[3] = { plugin->path, NULL, NULL }; 408 char *atmp[3] = { plugin->path, NULL, NULL };
409 409
410 if (gps == NULL || gps->load_sub == NULL) 410 if (gps == NULL || gps->load_sub == NULL)
411 return FALSE; 411 return FALSE;
412 412
413 gaim_debug(GAIM_DEBUG_INFO, "perl", "Loading perl script\n"); 413 purple_debug(PURPLE_DEBUG_INFO, "perl", "Loading perl script\n");
414 414
415 if (my_perl == NULL) 415 if (my_perl == NULL)
416 perl_init(); 416 perl_init();
417 417
418 plugin->handle = gps; 418 plugin->handle = gps;
419 419
420 atmp[1] = gps->package; 420 atmp[1] = gps->package;
421 421
422 PERL_SET_CONTEXT(my_perl); 422 PERL_SET_CONTEXT(my_perl);
423 execute_perl("Gaim::PerlLoader::load_n_eval", 2, atmp); 423 execute_perl("Purple::PerlLoader::load_n_eval", 2, atmp);
424 424
425 { 425 {
426 dSP; 426 dSP;
427 PERL_SET_CONTEXT(my_perl); 427 PERL_SET_CONTEXT(my_perl);
428 SPAGAIN; 428 SPAGAIN;
429 ENTER; 429 ENTER;
430 SAVETMPS; 430 SAVETMPS;
431 PUSHMARK(sp); 431 PUSHMARK(sp);
432 XPUSHs(sv_2mortal(gaim_perl_bless_object(plugin, 432 XPUSHs(sv_2mortal(purple_perl_bless_object(plugin,
433 "Gaim::Plugin"))); 433 "Purple::Plugin")));
434 PUTBACK; 434 PUTBACK;
435 435
436 perl_call_pv(gps->load_sub, G_EVAL | G_SCALAR); 436 perl_call_pv(gps->load_sub, G_EVAL | G_SCALAR);
437 SPAGAIN; 437 SPAGAIN;
438 438
439 if (SvTRUE(ERRSV)) { 439 if (SvTRUE(ERRSV)) {
440 STRLEN len; 440 STRLEN len;
441 441
442 gaim_debug(GAIM_DEBUG_ERROR, "perl", 442 purple_debug(PURPLE_DEBUG_ERROR, "perl",
443 "Perl function %s exited abnormally: %s\n", 443 "Perl function %s exited abnormally: %s\n",
444 gps->load_sub, SvPV(ERRSV, len)); 444 gps->load_sub, SvPV(ERRSV, len));
445 } 445 }
446 446
447 PUTBACK; 447 PUTBACK;
464 464
465 PUSHMARK(SP); 465 PUSHMARK(SP);
466 XPUSHs(sv_2mortal(newSVpv(package, strlen(package)))); 466 XPUSHs(sv_2mortal(newSVpv(package, strlen(package))));
467 PUTBACK; 467 PUTBACK;
468 468
469 perl_call_pv("Gaim::PerlLoader::destroy_package", 469 perl_call_pv("Purple::PerlLoader::destroy_package",
470 G_VOID | G_EVAL | G_DISCARD); 470 G_VOID | G_EVAL | G_DISCARD);
471 471
472 SPAGAIN; 472 SPAGAIN;
473 473
474 PUTBACK; 474 PUTBACK;
475 FREETMPS; 475 FREETMPS;
476 LEAVE; 476 LEAVE;
477 } 477 }
478 478
479 static gboolean 479 static gboolean
480 unload_perl_plugin(GaimPlugin *plugin) 480 unload_perl_plugin(PurplePlugin *plugin)
481 { 481 {
482 GaimPerlScript *gps = (GaimPerlScript *)plugin->info->extra_info; 482 PurplePerlScript *gps = (PurplePerlScript *)plugin->info->extra_info;
483 483
484 if (gps == NULL) 484 if (gps == NULL)
485 return FALSE; 485 return FALSE;
486 486
487 gaim_debug(GAIM_DEBUG_INFO, "perl", "Unloading perl script\n"); 487 purple_debug(PURPLE_DEBUG_INFO, "perl", "Unloading perl script\n");
488 488
489 if (gps->unload_sub != NULL) { 489 if (gps->unload_sub != NULL) {
490 dSP; 490 dSP;
491 PERL_SET_CONTEXT(my_perl); 491 PERL_SET_CONTEXT(my_perl);
492 SPAGAIN; 492 SPAGAIN;
493 ENTER; 493 ENTER;
494 SAVETMPS; 494 SAVETMPS;
495 PUSHMARK(sp); 495 PUSHMARK(sp);
496 XPUSHs(sv_2mortal(gaim_perl_bless_object(plugin, 496 XPUSHs(sv_2mortal(purple_perl_bless_object(plugin,
497 "Gaim::Plugin"))); 497 "Purple::Plugin")));
498 PUTBACK; 498 PUTBACK;
499 499
500 perl_call_pv(gps->unload_sub, G_EVAL | G_SCALAR); 500 perl_call_pv(gps->unload_sub, G_EVAL | G_SCALAR);
501 SPAGAIN; 501 SPAGAIN;
502 502
503 if (SvTRUE(ERRSV)) { 503 if (SvTRUE(ERRSV)) {
504 STRLEN len; 504 STRLEN len;
505 505
506 gaim_debug(GAIM_DEBUG_ERROR, "perl", 506 purple_debug(PURPLE_DEBUG_ERROR, "perl",
507 "Perl function %s exited abnormally: %s\n", 507 "Perl function %s exited abnormally: %s\n",
508 gps->load_sub, SvPV(ERRSV, len)); 508 gps->load_sub, SvPV(ERRSV, len));
509 } 509 }
510 510
511 PUTBACK; 511 PUTBACK;
512 FREETMPS; 512 FREETMPS;
513 LEAVE; 513 LEAVE;
514 } 514 }
515 515
516 gaim_perl_cmd_clear_for_plugin(plugin); 516 purple_perl_cmd_clear_for_plugin(plugin);
517 gaim_perl_signal_clear_for_plugin(plugin); 517 purple_perl_signal_clear_for_plugin(plugin);
518 gaim_perl_timeout_clear_for_plugin(plugin); 518 purple_perl_timeout_clear_for_plugin(plugin);
519 519
520 destroy_package(gps->package); 520 destroy_package(gps->package);
521 521
522 return TRUE; 522 return TRUE;
523 } 523 }
524 524
525 static void 525 static void
526 destroy_perl_plugin(GaimPlugin *plugin) 526 destroy_perl_plugin(PurplePlugin *plugin)
527 { 527 {
528 if (plugin->info != NULL) { 528 if (plugin->info != NULL) {
529 GaimPerlScript *gps; 529 PurplePerlScript *gps;
530 530
531 g_free(plugin->info->name); 531 g_free(plugin->info->name);
532 g_free(plugin->info->version); 532 g_free(plugin->info->version);
533 g_free(plugin->info->summary); 533 g_free(plugin->info->summary);
534 g_free(plugin->info->description); 534 g_free(plugin->info->description);
535 g_free(plugin->info->author); 535 g_free(plugin->info->author);
536 g_free(plugin->info->homepage); 536 g_free(plugin->info->homepage);
537 537
538 gps = (GaimPerlScript *)plugin->info->extra_info; 538 gps = (PurplePerlScript *)plugin->info->extra_info;
539 if (gps != NULL) { 539 if (gps != NULL) {
540 g_free(gps->load_sub); 540 g_free(gps->load_sub);
541 g_free(gps->unload_sub); 541 g_free(gps->unload_sub);
542 g_free(gps->package); 542 g_free(gps->package);
543 g_free(gps->prefs_sub); 543 g_free(gps->prefs_sub);
544 #ifdef GAIM_GTKPERL 544 #ifdef PURPLE_GTKPERL
545 g_free(gps->gtk_prefs_sub); 545 g_free(gps->gtk_prefs_sub);
546 #endif 546 #endif
547 g_free(gps); 547 g_free(gps);
548 plugin->info->extra_info = NULL; 548 plugin->info->extra_info = NULL;
549 } 549 }
550 } 550 }
551 } 551 }
552 552
553 static gboolean 553 static gboolean
554 plugin_load(GaimPlugin *plugin) 554 plugin_load(PurplePlugin *plugin)
555 { 555 {
556 return TRUE; 556 return TRUE;
557 } 557 }
558 558
559 static gboolean 559 static gboolean
560 plugin_unload(GaimPlugin *plugin) 560 plugin_unload(PurplePlugin *plugin)
561 { 561 {
562 perl_end(); 562 perl_end();
563 563
564 return TRUE; 564 return TRUE;
565 } 565 }
566 566
567 static GaimPluginLoaderInfo loader_info = 567 static PurplePluginLoaderInfo loader_info =
568 { 568 {
569 NULL, /**< exts */ 569 NULL, /**< exts */
570 probe_perl_plugin, /**< probe */ 570 probe_perl_plugin, /**< probe */
571 load_perl_plugin, /**< load */ 571 load_perl_plugin, /**< load */
572 unload_perl_plugin, /**< unload */ 572 unload_perl_plugin, /**< unload */
573 destroy_perl_plugin /**< destroy */ 573 destroy_perl_plugin /**< destroy */
574 }; 574 };
575 575
576 static GaimPluginInfo info = 576 static PurplePluginInfo info =
577 { 577 {
578 GAIM_PLUGIN_MAGIC, 578 PURPLE_PLUGIN_MAGIC,
579 GAIM_MAJOR_VERSION, 579 PURPLE_MAJOR_VERSION,
580 GAIM_MINOR_VERSION, 580 PURPLE_MINOR_VERSION,
581 GAIM_PLUGIN_LOADER, /**< type */ 581 PURPLE_PLUGIN_LOADER, /**< type */
582 NULL, /**< ui_requirement */ 582 NULL, /**< ui_requirement */
583 0, /**< flags */ 583 0, /**< flags */
584 NULL, /**< dependencies */ 584 NULL, /**< dependencies */
585 GAIM_PRIORITY_DEFAULT, /**< priority */ 585 PURPLE_PRIORITY_DEFAULT, /**< priority */
586 586
587 PERL_PLUGIN_ID, /**< id */ 587 PERL_PLUGIN_ID, /**< id */
588 N_("Perl Plugin Loader"), /**< name */ 588 N_("Perl Plugin Loader"), /**< name */
589 VERSION, /**< version */ 589 VERSION, /**< version */
590 N_("Provides support for loading perl plugins."), /**< summary */ 590 N_("Provides support for loading perl plugins."), /**< summary */
591 N_("Provides support for loading perl plugins."), /**< description */ 591 N_("Provides support for loading perl plugins."), /**< description */
592 "Christian Hammond <chipx86@gnupdate.org>", /**< author */ 592 "Christian Hammond <chipx86@gnupdate.org>", /**< author */
593 GAIM_WEBSITE, /**< homepage */ 593 PURPLE_WEBSITE, /**< homepage */
594 594
595 plugin_load, /**< load */ 595 plugin_load, /**< load */
596 plugin_unload, /**< unload */ 596 plugin_unload, /**< unload */
597 NULL, /**< destroy */ 597 NULL, /**< destroy */
598 598
601 NULL, 601 NULL,
602 NULL 602 NULL
603 }; 603 };
604 604
605 static void 605 static void
606 init_plugin(GaimPlugin *plugin) 606 init_plugin(PurplePlugin *plugin)
607 { 607 {
608 loader_info.exts = g_list_append(loader_info.exts, "pl"); 608 loader_info.exts = g_list_append(loader_info.exts, "pl");
609 } 609 }
610 610
611 GAIM_INIT_PLUGIN(perl, init_plugin, info) 611 PURPLE_INIT_PLUGIN(perl, init_plugin, info)