changeset 19196:e1afc0e009d2

Make perl loader more robust - use G_EVAL flag on all calls so that if the perl function dies, it doesn't cause libpurple to quit.

--- a/libpurple/plugins/perl/perl-handlers.c	Sun Aug 12 00:52:17 2007 +0000
+++ b/libpurple/plugins/perl/perl-handlers.c	Sun Aug 12 01:52:10 2007 +0000
@@ -22,6 +22,7 @@
 	gchar *hvname;
 	PurplePlugin *plugin;
 	PurplePerlScript *gps;
+	STRLEN na;
 	dSP;
 
 	plugin = action->plugin;
@@ -45,9 +46,16 @@
 	XPUSHs(purple_perl_bless_object(gps->plugin, "Purple::Plugin"));
 	PUTBACK;
 
-	call_sv(*callback, G_VOID | G_DISCARD);
+	call_sv(*callback, G_EVAL | G_VOID | G_DISCARD);
+
 	SPAGAIN;
 
+	if (SvTRUE(ERRSV)) {
+		purple_debug_error("perl",
+		                 "Perl plugin action function exited abnormally: %s\n",
+		                 SvPV(ERRSV, na));
+	}
+
 	PUTBACK;
 	FREETMPS;
 	LEAVE;
@@ -59,6 +67,7 @@
 	GList *l = NULL;
 	PurplePerlScript *gps;
 	int i = 0, count = 0;
+	STRLEN na;
 	dSP;
 
 	gps = (PurplePerlScript *)plugin->info->extra_info;
@@ -77,10 +86,16 @@
 		XPUSHs(&PL_sv_undef);
 	PUTBACK;
 
-	count = call_pv(gps->plugin_action_sub, G_ARRAY);
+	count = call_pv(gps->plugin_action_sub, G_EVAL | G_ARRAY);
 
 	SPAGAIN;
 
+	if (SvTRUE(ERRSV)) {
+		purple_debug_error("perl",
+		                 "Perl plugin actions lookup exited abnormally: %s\n",
+		                 SvPV(ERRSV, na));
+	}
+
 	if (count == 0)
 		croak("The plugin_actions sub didn't return anything.\n");
 
@@ -113,6 +128,7 @@
 	MAGIC *mg;
 	GtkWidget *ret;
 	PurplePerlScript *gps;
+	STRLEN na;
 	dSP;
 
 	gps = (PurplePerlScript *)plugin->info->extra_info;
@@ -120,13 +136,19 @@
 	ENTER;
 	SAVETMPS;
 
-	count = call_pv(gps->gtk_prefs_sub, G_SCALAR | G_NOARGS);
+	count = call_pv(gps->gtk_prefs_sub, G_EVAL | G_SCALAR | G_NOARGS);
 	if (count != 1)
 		croak("call_pv: Did not return the correct number of values.\n");
 
 	/* the frame was created in a perl sub and is returned */
 	SPAGAIN;
 
+	if (SvTRUE(ERRSV)) {
+		purple_debug_error("perl",
+		                 "Perl gtk plugin frame init exited abnormally: %s\n",
+		                 SvPV(ERRSV, na));
+	}
+
 	/* We have a Gtk2::Frame on top of the stack */
 	sv = POPs;
 
@@ -150,6 +172,7 @@
 	int count;
 	PurplePerlScript *gps;
 	PurplePluginPrefFrame *ret_frame;
+	STRLEN na;
 	dSP;
 
 	gps = (PurplePerlScript *)plugin->info->extra_info;
@@ -161,10 +184,16 @@
 	PUSHMARK(SP);
 	PUTBACK;
 
-	count = call_pv(gps->prefs_sub, G_SCALAR | G_NOARGS);
+	count = call_pv(gps->prefs_sub, G_EVAL | G_SCALAR | G_NOARGS);
 
 	SPAGAIN;
 
+	if (SvTRUE(ERRSV)) {
+		purple_debug_error("perl",
+		                 "Perl plugin prefs frame init exited abnormally: %s\n",
+		                 SvPV(ERRSV, na));
+	}
+
 	if (count != 1)
 		croak("call_pv: Did not return the correct number of values.\n");
 	/* the frame was created in a perl sub and is returned */
@@ -215,6 +244,7 @@
 {
 	PurplePerlTimeoutHandler *handler = (PurplePerlTimeoutHandler *)data;
 	gboolean ret = FALSE;
+	STRLEN na;
 
 	dSP;
 	ENTER;
@@ -225,6 +255,12 @@
 	call_sv(handler->callback, G_EVAL | G_SCALAR);
 	SPAGAIN;
 
+	if (SvTRUE(ERRSV)) {
+		purple_debug_error("perl",
+		                 "Perl timeout function exited abnormally: %s\n",
+		                 SvPV(ERRSV, na));
+	}
+
 	ret = POPi;
 
 	PUTBACK;
@@ -285,7 +321,7 @@
 		else
 			ret_val = purple_perl_data_from_sv(ret_value, POPs);
 	} else {
-		call_sv(handler->callback, G_SCALAR);
+		call_sv(handler->callback, G_EVAL | G_SCALAR);
 
 		SPAGAIN;
 	}
@@ -501,6 +537,7 @@
             gchar **args, gchar **error, void *data)
 {
 	int i = 0, count, ret_value = PURPLE_CMD_RET_OK;
+	STRLEN na;
 	SV *cmdSV, *tmpSV, *convSV;
 	PurplePerlCmdHandler *handler = (PurplePerlCmdHandler *)data;
 
@@ -532,11 +569,17 @@
 	}
 
 	PUTBACK;
-	count = call_sv(handler->callback, G_EVAL|G_SCALAR);
+	count = call_sv(handler->callback, G_EVAL | G_SCALAR);
 
 	if (count != 1)
 		croak("call_sv: Did not return the correct number of values.\n");
 
+	if (SvTRUE(ERRSV)) {
+		purple_debug_error("perl",
+		                 "Perl plugin command function exited abnormally: %s\n",
+		                 SvPV(ERRSV, na));
+	}
+
 	SPAGAIN;
 
 	ret_value = POPi;