Mercurial > pidgin

comparison libpurple/plugins/perl/perl.c @ 23653:6f47135f5378

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Some cleanup and a couple leak fixes.
author Daniel Atallah <daniel.atallah@gmail.com>
date Thu, 07 Aug 2008 01:41:44 +0000
parents 57419367b18d
children 1f92d4aa8f3b
comparison
equal deleted inserted replaced
23652:27eacd38c721 23653:6f47135f5378
286 #endif 286 #endif
287 287
288 ret = perl_parse(prober, xs_init, argc, argv, NULL); 288 ret = perl_parse(prober, xs_init, argc, argv, NULL);
289 289
290 if (ret != 0) { 290 if (ret != 0) {
291 STRLEN len;
292 const char * errmsg = "Unknown error"; 291 const char * errmsg = "Unknown error";
293 if (SvTRUE(ERRSV)) 292 if (SvTRUE(ERRSV))
294 errmsg = SvPV(ERRSV, len); 293 errmsg = SvPVutf8_nolen(ERRSV);
295 purple_debug_error("perl", "Unable to parse plugin %s (%d:%s)\n", 294 purple_debug_error("perl", "Unable to parse plugin %s (%d:%s)\n",
296 plugin->path, ret, errmsg); 295 plugin->path, ret, errmsg);
296 status = FALSE;
297 goto cleanup; 297 goto cleanup;
298 } 298 }
299 299
300 ret = perl_run(prober); 300 ret = perl_run(prober);
301 301
302 if (ret != 0) { 302 if (ret != 0) {
303 STRLEN len;
304 const char * errmsg = "Unknown error"; 303 const char * errmsg = "Unknown error";
305 if (SvTRUE(ERRSV)) 304 if (SvTRUE(ERRSV))
306 errmsg = SvPV(ERRSV, len); 305 errmsg = SvPVutf8_nolen(ERRSV);
307 purple_debug_error("perl", "Unable to run perl interpreter on plugin %s (%d:%s)\n", 306 purple_debug_error("perl", "Unable to run perl interpreter on plugin %s (%d:%s)\n",
308 plugin->path, ret, errmsg); 307 plugin->path, ret, errmsg);
308 status = FALSE;
309 goto cleanup; 309 goto cleanup;
310 } 310 }
311 311
312 plugin_info = perl_get_hv("PLUGIN_INFO", FALSE); 312 plugin_info = perl_get_hv("PLUGIN_INFO", FALSE);
313 313
333 status = FALSE; 333 status = FALSE;
334 else { 334 else {
335 PurplePluginInfo *info; 335 PurplePluginInfo *info;
336 PurplePerlScript *gps; 336 PurplePerlScript *gps;
337 char *basename; 337 char *basename;
338 STRLEN len;
339 338
340 info = g_new0(PurplePluginInfo, 1); 339 info = g_new0(PurplePluginInfo, 1);
341 gps = g_new0(PurplePerlScript, 1); 340 gps = g_new0(PurplePerlScript, 1);
342 341
343 info->magic = PURPLE_PLUGIN_MAGIC; 342 info->magic = PURPLE_PLUGIN_MAGIC;
356 basename); 355 basename);
357 g_free(basename); 356 g_free(basename);
358 357
359 /* We know this one exists. */ 358 /* We know this one exists. */
360 key = hv_fetch(plugin_info, "name", strlen("name"), 0); 359 key = hv_fetch(plugin_info, "name", strlen("name"), 0);
361 info->name = g_strdup(SvPV(*key, len)); 360 info->name = g_strdup(SvPVutf8_nolen(*key));
362 /* Set id here in case we don't find one later. */ 361 /* Set id here in case we don't find one later. */
363 info->id = g_strdup(SvPV(*key, len)); 362 info->id = g_strdup(info->name);
364 363
365 #ifdef PURPLE_GTKPERL 364 #ifdef PURPLE_GTKPERL
366 if ((key = hv_fetch(plugin_info, "GTK_UI", 365 if ((key = hv_fetch(plugin_info, "GTK_UI",
367 strlen("GTK_UI"), 0))) 366 strlen("GTK_UI"), 0)))
368 info->ui_requirement = PURPLE_GTK_PLUGIN_TYPE; 367 info->ui_requirement = PURPLE_GTK_PLUGIN_TYPE;
369 #endif 368 #endif
370 369
371 if ((key = hv_fetch(plugin_info, "url", 370 if ((key = hv_fetch(plugin_info, "url",
372 strlen("url"), 0))) 371 strlen("url"), 0)))
373 info->homepage = g_strdup(SvPV(*key, len)); 372 info->homepage = g_strdup(SvPVutf8_nolen(*key));
374 373
375 if ((key = hv_fetch(plugin_info, "author", 374 if ((key = hv_fetch(plugin_info, "author",
376 strlen("author"), 0))) 375 strlen("author"), 0)))
377 info->author = g_strdup(SvPV(*key, len)); 376 info->author = g_strdup(SvPVutf8_nolen(*key));
378 377
379 if ((key = hv_fetch(plugin_info, "summary", 378 if ((key = hv_fetch(plugin_info, "summary",
380 strlen("summary"), 0))) 379 strlen("summary"), 0)))
381 info->summary = g_strdup(SvPV(*key, len)); 380 info->summary = g_strdup(SvPVutf8_nolen(*key));
382 381
383 if ((key = hv_fetch(plugin_info, "description", 382 if ((key = hv_fetch(plugin_info, "description",
384 strlen("description"), 0))) 383 strlen("description"), 0)))
385 info->description = g_strdup(SvPV(*key, len)); 384 info->description = g_strdup(SvPVutf8_nolen(*key));
386 385
387 if ((key = hv_fetch(plugin_info, "version", 386 if ((key = hv_fetch(plugin_info, "version",
388 strlen("version"), 0))) 387 strlen("version"), 0)))
389 info->version = g_strdup(SvPV(*key, len)); 388 info->version = g_strdup(SvPVutf8_nolen(*key));
390 389
391 /* We know this one exists. */ 390 /* We know this one exists. */
392 key = hv_fetch(plugin_info, "load", strlen("load"), 0); 391 key = hv_fetch(plugin_info, "load", strlen("load"), 0);
393 gps->load_sub = g_strdup_printf("%s::%s", gps->package, 392 gps->load_sub = g_strdup_printf("%s::%s", gps->package,
394 SvPV(*key, len)); 393 SvPVutf8_nolen(*key));
395 394
396 if ((key = hv_fetch(plugin_info, "unload", 395 if ((key = hv_fetch(plugin_info, "unload",
397 strlen("unload"), 0))) 396 strlen("unload"), 0)))
398 gps->unload_sub = g_strdup_printf("%s::%s", 397 gps->unload_sub = g_strdup_printf("%s::%s",
399 gps->package, 398 gps->package,
400 SvPV(*key, len)); 399 SvPVutf8_nolen(*key));
401 400
402 if ((key = hv_fetch(plugin_info, "id", 401 if ((key = hv_fetch(plugin_info, "id",
403 strlen("id"), 0))) { 402 strlen("id"), 0))) {
404 g_free(info->id); 403 g_free(info->id);
405 info->id = g_strdup_printf("perl-%s", 404 info->id = g_strdup_printf("perl-%s",
406 SvPV(*key, len)); 405 SvPVutf8_nolen(*key));
407 } 406 }
408 407
409 /********************************************************/ 408 /********************************************************/
410 /* Only one of the next two options should be present */ 409 /* Only one of the next two options should be present */
411 /* */ 410 /* */
422 strlen("prefs_info"), 0))) { 421 strlen("prefs_info"), 0))) {
423 /* key now is the name of the Perl sub that 422 /* key now is the name of the Perl sub that
424 * will create a frame for us */ 423 * will create a frame for us */
425 gps->prefs_sub = g_strdup_printf("%s::%s", 424 gps->prefs_sub = g_strdup_printf("%s::%s",
426 gps->package, 425 gps->package,
427 SvPV(*key, len)); 426 SvPVutf8_nolen(*key));
428 info->prefs_info = &ui_info; 427 info->prefs_info = &ui_info;
429 } 428 }
430 429
431 #ifdef PURPLE_GTKPERL 430 #ifdef PURPLE_GTKPERL
432 if ((key = hv_fetch(plugin_info, "gtk_prefs_info", 431 if ((key = hv_fetch(plugin_info, "gtk_prefs_info",
433 strlen("gtk_prefs_info"), 0))) { 432 strlen("gtk_prefs_info"), 0))) {
434 /* key now is the name of the Perl sub that 433 /* key now is the name of the Perl sub that
435 * will create a frame for us */ 434 * will create a frame for us */
436 gps->gtk_prefs_sub = g_strdup_printf("%s::%s", 435 gps->gtk_prefs_sub = g_strdup_printf("%s::%s",
437 gps->package, 436 gps->package,
438 SvPV(*key, len)); 437 SvPVutf8_nolen(*key));
439 info->ui_info = &gtk_ui_info; 438 info->ui_info = &gtk_ui_info;
440 } 439 }
441 #endif 440 #endif
442 441
443 if ((key = hv_fetch(plugin_info, "plugin_action_sub", 442 if ((key = hv_fetch(plugin_info, "plugin_action_sub",
444 strlen("plugin_action_sub"), 0))) { 443 strlen("plugin_action_sub"), 0))) {
445 gps->plugin_action_sub = g_strdup_printf("%s::%s", 444 gps->plugin_action_sub = g_strdup_printf("%s::%s",
446 gps->package, 445 gps->package,
447 SvPV(*key, len)); 446 SvPVutf8_nolen(*key));
448 info->actions = purple_perl_plugin_actions; 447 info->actions = purple_perl_plugin_actions;
449 } 448 }
450 449
451 plugin->info = info; 450 plugin->info = info;
452 info->extra_info = gps; 451 info->extra_info = gps;
497 496
498 perl_call_pv(gps->load_sub, G_EVAL | G_SCALAR); 497 perl_call_pv(gps->load_sub, G_EVAL | G_SCALAR);
499 SPAGAIN; 498 SPAGAIN;
500 499
501 if (SvTRUE(ERRSV)) { 500 if (SvTRUE(ERRSV)) {
502 STRLEN len;
503
504 purple_debug(PURPLE_DEBUG_ERROR, "perl", 501 purple_debug(PURPLE_DEBUG_ERROR, "perl",
505 "Perl function %s exited abnormally: %s\n", 502 "Perl function %s exited abnormally: %s\n",
506 gps->load_sub, SvPV(ERRSV, len)); 503 gps->load_sub, SvPVutf8_nolen(ERRSV));
507 } 504 }
508 505
509 PUTBACK; 506 PUTBACK;
510 FREETMPS; 507 FREETMPS;
511 LEAVE; 508 LEAVE;
523 520
524 ENTER; 521 ENTER;
525 SAVETMPS; 522 SAVETMPS;
526 523
527 PUSHMARK(SP); 524 PUSHMARK(SP);
528 XPUSHs(sv_2mortal(newSVpv(package, strlen(package)))); 525 XPUSHs(sv_2mortal(newSVpv(package, 0)));
529 PUTBACK; 526 PUTBACK;
530 527
531 perl_call_pv("Purple::PerlLoader::destroy_package", 528 perl_call_pv("Purple::PerlLoader::destroy_package",
532 G_VOID | G_EVAL | G_DISCARD); 529 G_VOID | G_EVAL | G_DISCARD);
533 530
561 558
562 perl_call_pv(gps->unload_sub, G_EVAL | G_SCALAR); 559 perl_call_pv(gps->unload_sub, G_EVAL | G_SCALAR);
563 SPAGAIN; 560 SPAGAIN;
564 561
565 if (SvTRUE(ERRSV)) { 562 if (SvTRUE(ERRSV)) {
566 STRLEN len;
567
568 purple_debug(PURPLE_DEBUG_ERROR, "perl", 563 purple_debug(PURPLE_DEBUG_ERROR, "perl",
569 "Perl function %s exited abnormally: %s\n", 564 "Perl function %s exited abnormally: %s\n",
570 gps->load_sub, SvPV(ERRSV, len)); 565 gps->unload_sub, SvPVutf8_nolen(ERRSV));
571 } 566 }
572 567
573 PUTBACK; 568 PUTBACK;
574 FREETMPS; 569 FREETMPS;
575 LEAVE; 570 LEAVE;
590 { 585 {
591 if (plugin->info != NULL) { 586 if (plugin->info != NULL) {
592 PurplePerlScript *gps; 587 PurplePerlScript *gps;
593 588
594 g_free(plugin->info->name); 589 g_free(plugin->info->name);
595 g_free(plugin->info->version); 590 g_free(plugin->info->id);
591 g_free(plugin->info->homepage);
592 g_free(plugin->info->author);
596 g_free(plugin->info->summary); 593 g_free(plugin->info->summary);
597 g_free(plugin->info->description); 594 g_free(plugin->info->description);
598 g_free(plugin->info->author); 595 g_free(plugin->info->version);
599 g_free(plugin->info->homepage);
600 596
601 gps = (PurplePerlScript *)plugin->info->extra_info; 597 gps = (PurplePerlScript *)plugin->info->extra_info;
602 if (gps != NULL) { 598 if (gps != NULL) {
599 g_free(gps->package);
603 g_free(gps->load_sub); 600 g_free(gps->load_sub);
604 g_free(gps->unload_sub); 601 g_free(gps->unload_sub);
605 g_free(gps->package);
606 g_free(gps->prefs_sub); 602 g_free(gps->prefs_sub);
607 #ifdef PURPLE_GTKPERL 603 #ifdef PURPLE_GTKPERL
608 g_free(gps->gtk_prefs_sub); 604 g_free(gps->gtk_prefs_sub);
609 #endif 605 #endif
606 g_free(gps->plugin_action_sub);
610 g_free(gps); 607 g_free(gps);
611 plugin->info->extra_info = NULL; 608 plugin->info->extra_info = NULL;
612 } 609 }
613 } 610 }
614 } 611 }