changeset 23663:fb86dbeb2b15

Add support to the Perl plugin loader for listing for pref changes. The Prefs Functions Test plugin (plugin_pref.pl) includes an example. Fixes #6383
author Daniel Atallah <daniel.atallah@gmail.com>
date Wed, 30 Jul 2008 03:51:26 +0000
parents f5e614bc6606
children ece34c9599f5
files libpurple/plugins/perl/common/Prefs.xs libpurple/plugins/perl/perl-handlers.c libpurple/plugins/perl/perl-handlers.h libpurple/plugins/perl/perl.c libpurple/plugins/perl/scripts/plugin_pref.pl
diffstat 5 files changed, 188 insertions(+), 10 deletions(-) [+]
line wrap: on
line diff
--- a/libpurple/plugins/perl/common/Prefs.xs	Tue Jul 29 23:51:06 2008 +0000
+++ b/libpurple/plugins/perl/common/Prefs.xs	Wed Jul 30 03:51:26 2008 +0000
@@ -1,4 +1,5 @@
 #include "module.h"
+#include "../perl-handlers.h"
 
 MODULE = Purple::Prefs  PACKAGE = Purple::Prefs  PREFIX = purple_prefs_
 PROTOTYPES: ENABLE
@@ -62,13 +63,28 @@
 void
 purple_prefs_destroy()
 
+guint
+purple_prefs_connect_callback(plugin, name, callback, data = 0);
+	Purple::Plugin plugin
+	const char *name
+	SV *callback
+	SV *data
+CODE:
+	RETVAL = purple_perl_prefs_connect_callback(plugin, name, callback, data);
+OUTPUT:
+	RETVAL
+
 void
-purple_prefs_disconnect_by_handle(handle)
-	void * handle
+purple_prefs_disconnect_by_handle(plugin)
+	Purple::Plugin plugin
+CODE:
+	purple_perl_pref_cb_clear_for_plugin(plugin);
 
 void
 purple_prefs_disconnect_callback(callback_id)
 	guint callback_id
+CODE:
+	purple_perl_prefs_disconnect_callback(callback_id);
 
 gboolean
 purple_prefs_exists(name)
--- a/libpurple/plugins/perl/perl-handlers.c	Tue Jul 29 23:51:06 2008 +0000
+++ b/libpurple/plugins/perl/perl-handlers.c	Wed Jul 30 03:51:26 2008 +0000
@@ -8,6 +8,7 @@
 static GList *cmd_handlers = NULL;
 static GList *signal_handlers = NULL;
 static GList *timeout_handlers = NULL;
+static GSList *pref_handlers = NULL;
 
 /* perl < 5.8.0 doesn't define PERL_MAGIC_ext */
 #ifndef PERL_MAGIC_ext
@@ -715,3 +716,141 @@
 	purple_cmd_unregister(id);
 	destroy_cmd_handler(handler);
 }
+
+static void
+perl_pref_cb(const char *name, PurplePrefType type, gconstpointer value,
+			 gpointer data)
+{
+	PurplePerlPrefsHandler *handler = data;
+	STRLEN na;
+
+	dSP;
+	ENTER;
+	SAVETMPS;
+	PUSHMARK(sp);
+	XPUSHs(sv_2mortal(newSVpv(name, 0)));
+
+	XPUSHs(sv_2mortal(newSViv(type)));
+
+	switch(type) {
+		case PURPLE_PREF_INT:
+			XPUSHs(sv_2mortal(newSViv(GPOINTER_TO_INT(value))));
+			break;
+		case PURPLE_PREF_BOOLEAN:
+			XPUSHs((GPOINTER_TO_INT(value) == FALSE) ? &PL_sv_no : &PL_sv_yes);
+			break;
+		case PURPLE_PREF_STRING:
+		case PURPLE_PREF_PATH:
+			XPUSHs(sv_2mortal(newSVGChar(value)));
+			break;
+		case PURPLE_PREF_STRING_LIST:
+		case PURPLE_PREF_PATH_LIST:
+			{
+				AV* av = newAV();
+				const GList *l = value;
+
+				/* Append stuff backward to preserve order */
+				while (l && l->next) l = l->next;
+				while (l) {
+					av_push(av, sv_2mortal(newSVGChar(l->data)));
+					l = l->prev;
+				}
+				XPUSHs(sv_2mortal(newRV_noinc((SV *) av)));
+			} break;
+		default:
+		case PURPLE_PREF_NONE:
+			XPUSHs(&PL_sv_undef);
+			break;
+	}
+
+	XPUSHs((SV *)handler->data);
+	PUTBACK;
+	call_sv(handler->callback, G_EVAL | G_VOID | G_DISCARD);
+	SPAGAIN;
+
+	if (SvTRUE(ERRSV)) {
+		purple_debug_error("perl",
+		                 "Perl prefs callback function exited abnormally: %s\n",
+		                 SvPV(ERRSV, na));
+	}
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+}
+
+guint
+purple_perl_prefs_connect_callback(PurplePlugin *plugin, const char *name,
+								   SV *callback, SV *data)
+{
+	PurplePerlPrefsHandler *handler;
+
+	if (plugin == NULL) {
+		croak("Invalid handle in adding perl prefs handler.\n");
+		return 0;
+	}
+
+	handler = g_new0(PurplePerlPrefsHandler, 1);
+
+	handler->plugin   = plugin;
+	handler->callback = (callback != NULL && callback != &PL_sv_undef
+	                     ? newSVsv(callback) : NULL);
+	handler->data     = (data != NULL && data != &PL_sv_undef
+	                     ? newSVsv(data) : NULL);
+
+	pref_handlers = g_slist_prepend(pref_handlers, handler);
+
+	handler->iotag = purple_prefs_connect_callback(plugin, name, perl_pref_cb, handler);
+
+	return handler->iotag;
+}
+
+static void
+destroy_prefs_handler(PurplePerlPrefsHandler *handler)
+{
+	pref_handlers = g_slist_remove(pref_handlers, handler);
+
+	if (handler->iotag > 0)
+		purple_prefs_disconnect_callback(handler->iotag);
+
+	if (handler->callback != NULL)
+		SvREFCNT_dec(handler->callback);
+
+	if (handler->data != NULL)
+		SvREFCNT_dec(handler->data);
+
+	g_free(handler);
+}
+
+void purple_perl_prefs_disconnect_callback(guint callback_id)
+{
+	GSList *l, *l_next;
+	PurplePerlPrefsHandler *handler;
+
+	for (l = pref_handlers; l != NULL; l = l_next) {
+		l_next = l->next;
+		handler = l->data;
+
+		if (handler->iotag == callback_id) {
+			destroy_prefs_handler(handler);
+			return;
+		}
+	}
+
+	purple_debug_info("perl", "No prefs handler found with handle %u.\n",
+	                  callback_id);
+}
+
+void purple_perl_pref_cb_clear_for_plugin(PurplePlugin *plugin)
+{
+	GSList *l, *l_next;
+	PurplePerlPrefsHandler *handler;
+
+	for (l = pref_handlers; l != NULL; l = l_next) {
+		l_next = l->next;
+		handler = l->data;
+
+		if (handler->plugin == plugin)
+			destroy_prefs_handler(handler);
+	}
+}
--- a/libpurple/plugins/perl/perl-handlers.h	Tue Jul 29 23:51:06 2008 +0000
+++ b/libpurple/plugins/perl/perl-handlers.h	Wed Jul 30 03:51:26 2008 +0000
@@ -15,8 +15,8 @@
 	PurpleCmdId id;
 	SV *callback;
 	SV *data;
-	char *prpl_id;
-	char *cmd;
+	gchar *prpl_id;
+	gchar *cmd;
 	PurplePlugin *plugin;
 } PurplePerlCmdHandler;
 
@@ -31,7 +31,7 @@
 
 typedef struct
 {
-	char *signal;
+	gchar *signal;
 	SV *callback;
 	SV *data;
 	void *instance;
@@ -39,8 +39,17 @@
 
 } PurplePerlSignalHandler;
 
+typedef struct
+{
+	SV *callback;
+	SV *data;
+	PurplePlugin *plugin;
+	int iotag;
+
+} PurplePerlPrefsHandler;
+
 void purple_perl_plugin_action_cb(PurplePluginAction * gpa);
-GList *purple_perl_plugin_actions(PurplePlugin *plugin, gpointer context); 
+GList *purple_perl_plugin_actions(PurplePlugin *plugin, gpointer context);
 
 PurplePluginPrefFrame *purple_perl_get_plugin_frame(PurplePlugin *plugin);
 
@@ -69,4 +78,8 @@
 void purple_perl_cmd_unregister(PurpleCmdId id);
 void purple_perl_cmd_clear_for_plugin(PurplePlugin *plugin);
 
+guint purple_perl_prefs_connect_callback(PurplePlugin *plugin, const char *name, SV *callback, SV *data);
+void purple_perl_prefs_disconnect_callback(guint callback_id);
+void purple_perl_pref_cb_clear_for_plugin(PurplePlugin *plugin);
+
 #endif /* _PURPLE_PERL_HANDLERS_H_ */
--- a/libpurple/plugins/perl/perl.c	Tue Jul 29 23:51:06 2008 +0000
+++ b/libpurple/plugins/perl/perl.c	Wed Jul 30 03:51:26 2008 +0000
@@ -557,6 +557,7 @@
 	purple_perl_cmd_clear_for_plugin(plugin);
 	purple_perl_signal_clear_for_plugin(plugin);
 	purple_perl_timeout_clear_for_plugin(plugin);
+	purple_perl_pref_cb_clear_for_plugin(plugin);
 
 	destroy_package(gps->package);
 
--- a/libpurple/plugins/perl/scripts/plugin_pref.pl	Tue Jul 29 23:51:06 2008 +0000
+++ b/libpurple/plugins/perl/scripts/plugin_pref.pl	Wed Jul 30 03:51:26 2008 +0000
@@ -44,8 +44,8 @@
 	$ppref = Purple::PluginPref->new_with_name_and_label(
 	    "/plugins/core/perl_test/choice", "Choice Preference");
 	$ppref->set_type(1);
-	$ppref->add_choice("ch0", $frame);
-	$ppref->add_choice("ch1", $frame);
+	$ppref->add_choice("ch0", "ch0-val");
+	$ppref->add_choice("ch1", "ch1-val");
 	$frame->add($ppref);
 	
 	$ppref = Purple::PluginPref->new_with_name_and_label(
@@ -56,12 +56,17 @@
 	return $frame;
 }
 
+sub pref_cb {
+	my ($pref, $type, $value, $data) = @_;
+	
+	print "pref changed: [$pref]($type)=$value data=$data\n";
+}
+
 sub plugin_init { 
 	
 	return %PLUGIN_INFO; 
 } 
 
-
 # This is the sub defined in %PLUGIN_INFO to be called when the plugin is loaded
 #	Note: The plugin has a reference to itself on top of the argument stack.
 sub plugin_load { 
@@ -75,7 +80,11 @@
 	Purple::Prefs::add_bool("/plugins/core/perl_test/bool", 1);	
 	Purple::Prefs::add_string("/plugins/core/perl_test/choice", "ch1");	
 	Purple::Prefs::add_string("/plugins/core/perl_test/text", "Foobar");	
-	
+
+	Purple::Prefs::connect_callback($plugin, "/plugins/core/perl_test", \&pref_cb, "none");
+	Purple::Prefs::connect_callback($plugin, "/plugins/core/perl_test/bool", \&pref_cb, "bool");
+	Purple::Prefs::connect_callback($plugin, "/plugins/core/perl_test/choice", \&pref_cb, "choice");
+	Purple::Prefs::connect_callback($plugin, "/plugins/core/perl_test/text", \&pref_cb, "text");
 
 	print "\n\n" . "#" x 80 . "\n\n";
 }