# HG changeset patch # User Daniel Atallah # Date 1217389886 0 # Node ID fb86dbeb2b150693b3251195c0471228406a9da4 # Parent f5e614bc660614ec4ab75b294155e730237bfced 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 diff -r f5e614bc6606 -r fb86dbeb2b15 libpurple/plugins/perl/common/Prefs.xs --- 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) diff -r f5e614bc6606 -r fb86dbeb2b15 libpurple/plugins/perl/perl-handlers.c --- 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); + } +} diff -r f5e614bc6606 -r fb86dbeb2b15 libpurple/plugins/perl/perl-handlers.h --- 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_ */ diff -r f5e614bc6606 -r fb86dbeb2b15 libpurple/plugins/perl/perl.c --- 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); diff -r f5e614bc6606 -r fb86dbeb2b15 libpurple/plugins/perl/scripts/plugin_pref.pl --- 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"; }