Mercurial > pidgin.yaz
view libpurple/plugins/perl/perl-handlers.c @ 20016:2644267a6fb1
A couple more things for the ChangeLog
author | Kevin Stange <kevin@simguy.net> |
---|---|
date | Fri, 14 Sep 2007 06:20:12 +0000 |
parents | e1afc0e009d2 |
children | 870a580e8fde |
line wrap: on
line source
#include "perl-common.h" #include "perl-handlers.h" #include "debug.h" #include "signals.h" extern PerlInterpreter *my_perl; static GList *cmd_handlers = NULL; static GList *signal_handlers = NULL; static GList *timeout_handlers = NULL; /* perl < 5.8.0 doesn't define PERL_MAGIC_ext */ #ifndef PERL_MAGIC_ext #define PERL_MAGIC_ext '~' #endif void purple_perl_plugin_action_cb(PurplePluginAction *action) { SV **callback; HV *hv = NULL; gchar *hvname; PurplePlugin *plugin; PurplePerlScript *gps; STRLEN na; dSP; plugin = action->plugin; gps = (PurplePerlScript *)plugin->info->extra_info; hvname = g_strdup_printf("%s::plugin_actions", gps->package); hv = get_hv(hvname, FALSE); g_free(hvname); if (hv == NULL) croak("No plugin_actions hash found in \"%s\" plugin.", purple_plugin_get_name(plugin)); ENTER; SAVETMPS; callback = hv_fetch(hv, action->label, strlen(action->label), 0); if (callback == NULL || *callback == NULL) croak("No plugin_action function named \"%s\" in \"%s\" plugin.", action->label, purple_plugin_get_name(plugin)); PUSHMARK(sp); XPUSHs(purple_perl_bless_object(gps->plugin, "Purple::Plugin")); PUTBACK; 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; } GList * purple_perl_plugin_actions(PurplePlugin *plugin, gpointer context) { GList *l = NULL; PurplePerlScript *gps; int i = 0, count = 0; STRLEN na; dSP; gps = (PurplePerlScript *)plugin->info->extra_info; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(purple_perl_bless_object(plugin, "Purple::Plugin"))); /* XXX This *will* cease working correctly if context gets changed to * ever be able to hold anything other than a PurpleConnection */ if (context != NULL) XPUSHs(sv_2mortal(purple_perl_bless_object(context, "Purple::Connection"))); else XPUSHs(&PL_sv_undef); PUTBACK; 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"); for (i = 0; i < count; i++) { SV *sv; gchar *label; PurplePluginAction *act = NULL; sv = POPs; label = SvPV_nolen(sv); /* XXX I think this leaks, but doing it without the strdup * just showed garbage */ act = purple_plugin_action_new(g_strdup(label), purple_perl_plugin_action_cb); l = g_list_prepend(l, act); } PUTBACK; FREETMPS; LEAVE; return l; } #ifdef PURPLE_GTKPERL GtkWidget * purple_perl_gtk_get_plugin_frame(PurplePlugin *plugin) { SV * sv; int count; MAGIC *mg; GtkWidget *ret; PurplePerlScript *gps; STRLEN na; dSP; gps = (PurplePerlScript *)plugin->info->extra_info; ENTER; SAVETMPS; 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; /* The magic field hides the pointer to the actual GtkWidget */ mg = mg_find(SvRV(sv), PERL_MAGIC_ext); ret = (GtkWidget *)mg->mg_ptr; PUTBACK; FREETMPS; LEAVE; return ret; } #endif PurplePluginPrefFrame * purple_perl_get_plugin_frame(PurplePlugin *plugin) { /* Sets up the Perl Stack for our call back into the script to run the * plugin_pref... sub */ int count; PurplePerlScript *gps; PurplePluginPrefFrame *ret_frame; STRLEN na; dSP; gps = (PurplePerlScript *)plugin->info->extra_info; ENTER; SAVETMPS; /* Some perl magic to run perl_plugin_pref_frame_SV perl sub and * return the frame */ PUSHMARK(SP); PUTBACK; 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 */ ret_frame = (PurplePluginPrefFrame *)purple_perl_ref_object(POPs); /* Tidy up the Perl stack */ PUTBACK; FREETMPS; LEAVE; return ret_frame; } static void destroy_timeout_handler(PurplePerlTimeoutHandler *handler) { timeout_handlers = g_list_remove(timeout_handlers, handler); if (handler->iotag > 0) purple_timeout_remove(handler->iotag); if (handler->callback != NULL) SvREFCNT_dec(handler->callback); if (handler->data != NULL) SvREFCNT_dec(handler->data); g_free(handler); } static void destroy_signal_handler(PurplePerlSignalHandler *handler) { signal_handlers = g_list_remove(signal_handlers, handler); if (handler->callback != NULL) SvREFCNT_dec(handler->callback); if (handler->data != NULL) SvREFCNT_dec(handler->data); g_free(handler->signal); g_free(handler); } static gboolean perl_timeout_cb(gpointer data) { PurplePerlTimeoutHandler *handler = (PurplePerlTimeoutHandler *)data; gboolean ret = FALSE; STRLEN na; dSP; ENTER; SAVETMPS; PUSHMARK(sp); XPUSHs((SV *)handler->data); PUTBACK; 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; FREETMPS; LEAVE; if (ret == FALSE) destroy_timeout_handler(handler); return ret; } typedef void *DATATYPE; static void * perl_signal_cb(va_list args, void *data) { PurplePerlSignalHandler *handler = (PurplePerlSignalHandler *)data; void *ret_val = NULL; int i; int count; int value_count; PurpleValue *ret_value, **values; SV **sv_args; DATATYPE **copy_args; STRLEN na; dSP; ENTER; SAVETMPS; PUSHMARK(sp); purple_signal_get_values(handler->instance, handler->signal, &ret_value, &value_count, &values); sv_args = g_new(SV *, value_count); copy_args = g_new(void **, value_count); for (i = 0; i < value_count; i++) { sv_args[i] = purple_perl_sv_from_vargs(values[i], (va_list*)&args, ©_args[i]); XPUSHs(sv_args[i]); } XPUSHs((SV *)handler->data); PUTBACK; if (ret_value != NULL) { count = call_sv(handler->callback, G_EVAL | G_SCALAR); SPAGAIN; if (count != 1) croak("Uh oh! call_sv returned %i != 1", i); else ret_val = purple_perl_data_from_sv(ret_value, POPs); } else { call_sv(handler->callback, G_EVAL | G_SCALAR); SPAGAIN; } if (SvTRUE(ERRSV)) { purple_debug_error("perl", "Perl function exited abnormally: %s\n", SvPV(ERRSV, na)); } /* See if any parameters changed. */ for (i = 0; i < value_count; i++) { if (purple_value_is_outgoing(values[i])) { switch (purple_value_get_type(values[i])) { case PURPLE_TYPE_BOOLEAN: *((gboolean *)copy_args[i]) = SvIV(sv_args[i]); break; case PURPLE_TYPE_INT: *((int *)copy_args[i]) = SvIV(sv_args[i]); break; case PURPLE_TYPE_UINT: *((unsigned int *)copy_args[i]) = SvUV(sv_args[i]); break; case PURPLE_TYPE_LONG: *((long *)copy_args[i]) = SvIV(sv_args[i]); break; case PURPLE_TYPE_ULONG: *((unsigned long *)copy_args[i]) = SvUV(sv_args[i]); break; case PURPLE_TYPE_INT64: *((gint64 *)copy_args[i]) = SvIV(sv_args[i]); break; case PURPLE_TYPE_UINT64: *((guint64 *)copy_args[i]) = SvUV(sv_args[i]); break; case PURPLE_TYPE_STRING: if (strcmp(*((char **)copy_args[i]), SvPVX(sv_args[i]))) { g_free(*((char **)copy_args[i])); *((char **)copy_args[i]) = g_strdup(SvPV(sv_args[i], na)); } break; case PURPLE_TYPE_POINTER: *((void **)copy_args[i]) = (void *)SvIV(sv_args[i]); break; case PURPLE_TYPE_BOXED: *((void **)copy_args[i]) = (void *)SvIV(sv_args[i]); break; default: break; } #if 0 *((void **)copy_args[i]) = purple_perl_data_from_sv(values[i], sv_args[i]); #endif } } PUTBACK; FREETMPS; LEAVE; g_free(sv_args); g_free(copy_args); purple_debug_misc("perl", "ret_val = %p\n", ret_val); return ret_val; } static PurplePerlSignalHandler * find_signal_handler(PurplePlugin *plugin, void *instance, const char *signal) { PurplePerlSignalHandler *handler; GList *l; for (l = signal_handlers; l != NULL; l = l->next) { handler = (PurplePerlSignalHandler *)l->data; if (handler->plugin == plugin && handler->instance == instance && !strcmp(handler->signal, signal)) { return handler; } } return NULL; } void purple_perl_timeout_add(PurplePlugin *plugin, int seconds, SV *callback, SV *data) { PurplePerlTimeoutHandler *handler; if (plugin == NULL) { croak("Invalid handle in adding perl timeout handler.\n"); return; } handler = g_new0(PurplePerlTimeoutHandler, 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); timeout_handlers = g_list_append(timeout_handlers, handler); handler->iotag = purple_timeout_add(seconds * 1000, perl_timeout_cb, handler); } void purple_perl_timeout_clear_for_plugin(PurplePlugin *plugin) { PurplePerlTimeoutHandler *handler; GList *l, *l_next; for (l = timeout_handlers; l != NULL; l = l_next) { l_next = l->next; handler = (PurplePerlTimeoutHandler *)l->data; if (handler->plugin == plugin) destroy_timeout_handler(handler); } } void purple_perl_timeout_clear(void) { while (timeout_handlers != NULL) destroy_timeout_handler(timeout_handlers->data); } void purple_perl_signal_connect(PurplePlugin *plugin, void *instance, const char *signal, SV *callback, SV *data, int priority) { PurplePerlSignalHandler *handler; handler = g_new0(PurplePerlSignalHandler, 1); handler->plugin = plugin; handler->instance = instance; handler->signal = g_strdup(signal); handler->callback = (callback != NULL && callback != &PL_sv_undef ? newSVsv(callback) : NULL); handler->data = (data != NULL && data != &PL_sv_undef ? newSVsv(data) : NULL); signal_handlers = g_list_append(signal_handlers, handler); purple_signal_connect_priority_vargs(instance, signal, plugin, PURPLE_CALLBACK(perl_signal_cb), handler, priority); } void purple_perl_signal_disconnect(PurplePlugin *plugin, void *instance, const char *signal) { PurplePerlSignalHandler *handler; handler = find_signal_handler(plugin, instance, signal); if (handler == NULL) { croak("Invalid signal handler information in " "disconnecting a perl signal handler.\n"); return; } destroy_signal_handler(handler); } void purple_perl_signal_clear_for_plugin(PurplePlugin *plugin) { PurplePerlSignalHandler *handler; GList *l, *l_next; for (l = signal_handlers; l != NULL; l = l_next) { l_next = l->next; handler = (PurplePerlSignalHandler *)l->data; if (handler->plugin == plugin) destroy_signal_handler(handler); } } void purple_perl_signal_clear(void) { while (signal_handlers != NULL) destroy_signal_handler(signal_handlers->data); } static PurpleCmdRet perl_cmd_cb(PurpleConversation *conv, const gchar *command, 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; dSP; ENTER; SAVETMPS; PUSHMARK(SP); /* Push the conversation onto the perl stack */ convSV = sv_2mortal(purple_perl_bless_object(conv, "Purple::Conversation")); XPUSHs(convSV); /* Push the command string onto the perl stack */ cmdSV = newSVpv(command, 0); cmdSV = sv_2mortal(cmdSV); XPUSHs(cmdSV); /* Push the data onto the perl stack */ XPUSHs((SV *)handler->data); /* Push any arguments we may have */ for (i = 0; args[i] != NULL; i++) { /* XXX The mortality of these created SV's should prevent * memory issues, if I read/understood everything correctly... */ tmpSV = newSVpv(args[i], 0); tmpSV = sv_2mortal(tmpSV); XPUSHs(tmpSV); } PUTBACK; 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; PUTBACK; FREETMPS; LEAVE; return ret_value; } PurpleCmdId purple_perl_cmd_register(PurplePlugin *plugin, const gchar *command, const gchar *args, PurpleCmdPriority priority, PurpleCmdFlag flag, const gchar *prpl_id, SV *callback, const gchar *helpstr, SV *data) { PurplePerlCmdHandler *handler; handler = g_new0(PurplePerlCmdHandler, 1); handler->plugin = plugin; handler->cmd = g_strdup(command); handler->prpl_id = g_strdup(prpl_id); if (callback != NULL && callback != &PL_sv_undef) handler->callback = newSVsv(callback); else handler->callback = NULL; if (data != NULL && data != &PL_sv_undef) handler->data = newSVsv(data); else handler->data = NULL; cmd_handlers = g_list_append(cmd_handlers, handler); handler->id = purple_cmd_register(command, args, priority, flag, prpl_id, PURPLE_CMD_FUNC(perl_cmd_cb), helpstr, handler); return handler->id; } static void destroy_cmd_handler(PurplePerlCmdHandler *handler) { cmd_handlers = g_list_remove(cmd_handlers, handler); if (handler->callback != NULL) SvREFCNT_dec(handler->callback); if (handler->data != NULL) SvREFCNT_dec(handler->data); g_free(handler->cmd); g_free(handler->prpl_id); g_free(handler); } void purple_perl_cmd_clear_for_plugin(PurplePlugin *plugin) { GList *l, *l_next; for (l = cmd_handlers; l != NULL; l = l_next) { PurplePerlCmdHandler *handler = (PurplePerlCmdHandler *)l->data; l_next = l->next; if (handler->plugin == plugin) destroy_cmd_handler(handler); } } static PurplePerlCmdHandler * find_cmd_handler(PurpleCmdId id) { GList *l; for (l = cmd_handlers; l != NULL; l = l->next) { PurplePerlCmdHandler *handler = (PurplePerlCmdHandler *)l->data; if (handler->id == id) return handler; } return NULL; } void purple_perl_cmd_unregister(PurpleCmdId id) { PurplePerlCmdHandler *handler; handler = find_cmd_handler(id); if (handler == NULL) { croak("Invalid command id in removing a perl command handler.\n"); return; } purple_cmd_unregister(id); destroy_cmd_handler(handler); }