# HG changeset patch # User Etan Reisner # Date 1137311818 0 # Node ID e1603fd610faba59b4601bad3b96d44797827eab # Parent 7e45ccd91e586719a4dc393b04f2f3873b594f46 [gaim-migrate @ 15234] I give you perl /cmd support. I only tested this a little bit but it seemed to work for me, let me know if anything breaks. committer: Tailor Script diff -r 7e45ccd91e58 -r e1603fd610fa plugins/perl/common/Cmds.xs --- a/plugins/perl/common/Cmds.xs Sun Jan 15 07:43:09 2006 +0000 +++ b/plugins/perl/common/Cmds.xs Sun Jan 15 07:56:58 2006 +0000 @@ -1,30 +1,49 @@ #include "module.h" +#include "../perl-handlers.h" -MODULE = Gaim::Cmds PACKAGE = Gaim::Cmds PREFIX = gaim_cmd_ +MODULE = Gaim::Cmd PACKAGE = Gaim::Cmd PREFIX = gaim_cmd_ PROTOTYPES: ENABLE void -gaim_cmd_help(conv, cmd) +gaim_cmd_help(conv, command) Gaim::Conversation conv - const gchar *cmd + const gchar *command PREINIT: - GList *l; + GList *l; PPCODE: - for (l = gaim_cmd_help(conv, cmd); l != NULL; l = l->next) { - XPUSHs(sv_2mortal(gaim_perl_bless_object(l->data, "Gaim::ListEntry"))); - } + for (l = gaim_cmd_help(conv, command); l != NULL; l = l->next) { + XPUSHs(sv_2mortal(gaim_perl_bless_object(l->data, "Gaim::ListEntry"))); + } void gaim_cmd_list(conv) Gaim::Conversation conv PREINIT: - GList *l; + GList *l; PPCODE: - for (l = gaim_cmd_list(conv); l != NULL; l = l->next) { - XPUSHs(sv_2mortal(gaim_perl_bless_object(l->data, "Gaim::ListEntry"))); - } + for (l = gaim_cmd_list(conv); l != NULL; l = l->next) { + XPUSHs(sv_2mortal(gaim_perl_bless_object(l->data, "Gaim::ListEntry"))); + } -void +Gaim::Cmd::Id +gaim_cmd_register(plugin, command, args, priority, flag, prpl_id, func, helpstr, data = 0) + Gaim::Plugin plugin + const gchar *command + const gchar *args + Gaim::Cmd::Priority priority + Gaim::Cmd::Flag flag + const gchar *prpl_id + SV *func + const gchar *helpstr + SV *data +CODE: + RETVAL = gaim_perl_cmd_register(plugin, command, args, priority, flag, + prpl_id, func, helpstr, data); +OUTPUT: + RETVAL + +void gaim_cmd_unregister(id) - Gaim::CmdId id - + Gaim::Cmd::Id id +CODE: + gaim_perl_cmd_unregister(id); diff -r 7e45ccd91e58 -r e1603fd610fa plugins/perl/common/Gaim.xs --- a/plugins/perl/common/Gaim.xs Sun Jan 15 07:43:09 2006 +0000 +++ b/plugins/perl/common/Gaim.xs Sun Jan 15 07:56:58 2006 +0000 @@ -8,7 +8,7 @@ GAIM_PERL_BOOT_PROTO(Buddy__Icon); GAIM_PERL_BOOT_PROTO(BuddyList); GAIM_PERL_BOOT_PROTO(Cipher); -GAIM_PERL_BOOT_PROTO(Cmds); +GAIM_PERL_BOOT_PROTO(Cmd); GAIM_PERL_BOOT_PROTO(Connection); GAIM_PERL_BOOT_PROTO(Conversation); GAIM_PERL_BOOT_PROTO(Xfer); @@ -33,7 +33,6 @@ GAIM_PERL_BOOT_PROTO(Util); GAIM_PERL_BOOT_PROTO(XMLNode); - MODULE = Gaim PACKAGE = Gaim PREFIX = gaim_ PROTOTYPES: ENABLE @@ -41,11 +40,11 @@ BOOT: GAIM_PERL_BOOT(Account); - GAIM_PERL_BOOT(Account__Option); + GAIM_PERL_BOOT(Account__Option); GAIM_PERL_BOOT(Buddy__Icon); GAIM_PERL_BOOT(BuddyList); GAIM_PERL_BOOT(Cipher); - GAIM_PERL_BOOT(Cmds); + GAIM_PERL_BOOT(Cmd); GAIM_PERL_BOOT(Connection); GAIM_PERL_BOOT(Conversation); GAIM_PERL_BOOT(Xfer); @@ -54,7 +53,7 @@ GAIM_PERL_BOOT(Network); GAIM_PERL_BOOT(Notify); GAIM_PERL_BOOT(Plugin); - GAIM_PERL_BOOT(PluginPref); + GAIM_PERL_BOOT(PluginPref); GAIM_PERL_BOOT(Pounce); GAIM_PERL_BOOT(Prefs); GAIM_PERL_BOOT(Privacy); @@ -68,8 +67,7 @@ GAIM_PERL_BOOT(Status); GAIM_PERL_BOOT(Stringref); GAIM_PERL_BOOT(Util); - GAIM_PERL_BOOT(XMLNode); - + GAIM_PERL_BOOT(XMLNode); void timeout_add(plugin, seconds, callback, data = 0) @@ -143,4 +141,3 @@ deinit() CODE: gaim_perl_timeout_clear(); - diff -r 7e45ccd91e58 -r e1603fd610fa plugins/perl/common/module.h --- a/plugins/perl/common/module.h Sun Jan 15 07:43:09 2006 +0000 +++ b/plugins/perl/common/module.h Sun Jan 15 07:56:58 2006 +0000 @@ -84,7 +84,10 @@ typedef GaimCipherOps * Gaim__Cipher__Ops; /* cmds.h */ -typedef GaimCmdId Gaim__CmdId; +typedef GaimCmdFlag Gaim__Cmd__Flag; +typedef GaimCmdId Gaim__Cmd__Id; +typedef GaimCmdPriority Gaim__Cmd__Priority; +typedef GaimCmdRet Gaim__Cmd__Ret; /* connection.h */ typedef GaimConnection * Gaim__Connection; diff -r 7e45ccd91e58 -r e1603fd610fa plugins/perl/common/typemap --- a/plugins/perl/common/typemap Sun Jan 15 07:43:09 2006 +0000 +++ b/plugins/perl/common/typemap Sun Jan 15 07:56:58 2006 +0000 @@ -57,7 +57,10 @@ Gaim::CipherCaps T_IV Gaim::Cipher::Ops T_GaimObj Gaim::Cipher::Context T_GaimObj -Gaim::CmdId T_IV +Gaim::Cmd::Flag T_IV +Gaim::Cmd::Id T_IV +Gaim::Cmd::Priority T_IV +Gaim::Cmd::Ret T_IV Gaim::Connection T_GaimObj Gaim::Connection::UiOps T_GaimObj Gaim::Conversation T_GaimObj diff -r 7e45ccd91e58 -r e1603fd610fa plugins/perl/perl-handlers.c --- a/plugins/perl/perl-handlers.c Sun Jan 15 07:43:09 2006 +0000 +++ b/plugins/perl/perl-handlers.c Sun Jan 15 07:56:58 2006 +0000 @@ -4,9 +4,10 @@ #include "debug.h" #include "signals.h" -static GList *timeout_handlers = NULL; +extern PerlInterpreter *my_perl; +static GList *cmd_handlers = NULL; static GList *signal_handlers = NULL; -extern PerlInterpreter *my_perl; +static GList *timeout_handlers = NULL; /* perl < 5.8.0 doesn't define PERL_MAGIC_ext */ #ifndef PERL_MAGIC_ext @@ -441,3 +442,149 @@ while (signal_handlers != NULL) destroy_signal_handler(signal_handlers->data); } + +static GaimCmdRet +perl_cmd_cb(GaimConversation *conv, const gchar *command, + gchar **args, gchar **error, void *data) +{ + int i = 0, count, ret_value = GAIM_CMD_RET_OK; + SV *cmdSV, *tmpSV, *convSV; + GaimPerlCmdHandler *handler = (GaimPerlCmdHandler *)data; + + dSP; + ENTER; + SAVETMPS; + PUSHMARK(SP); + + /* Push the conversation onto the perl stack */ + convSV = sv_2mortal(gaim_perl_bless_object(conv, "Gaim::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"); + + SPAGAIN; + + ret_value = POPi; + + PUTBACK; + FREETMPS; + LEAVE; + + return ret_value; +} + +GaimCmdId +gaim_perl_cmd_register(GaimPlugin *plugin, const gchar *command, + const gchar *args, GaimCmdPriority priority, + GaimCmdFlag flag, const gchar *prpl_id, SV *callback, + const gchar *helpstr, SV *data) +{ + GaimPerlCmdHandler *handler; + + handler = g_new0(GaimPerlCmdHandler, 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 = gaim_cmd_register(command, args, priority, flag, prpl_id, + GAIM_CMD_FUNC(perl_cmd_cb), helpstr, + handler); + + return handler->id; +} + +static void +destroy_cmd_handler(GaimPerlCmdHandler *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 +gaim_perl_cmd_clear_for_plugin(GaimPlugin *plugin) +{ + GList *l, *l_next; + + for (l = cmd_handlers; l != NULL; l = l_next) { + GaimPerlCmdHandler *handler = (GaimPerlCmdHandler *)l->data; + + l_next = l->next; + + if (handler->plugin == plugin) + destroy_cmd_handler(handler); + } +} + +static GaimPerlCmdHandler * +find_cmd_handler(GaimCmdId id) +{ + GList *l; + + for (l = cmd_handlers; l != NULL; l = l->next) { + GaimPerlCmdHandler *handler = (GaimPerlCmdHandler *)l->data; + + if (handler->id == id) + return handler; + } + + return NULL; +} + +void +gaim_perl_cmd_unregister(GaimCmdId id) +{ + GaimPerlCmdHandler *handler; + + handler = find_cmd_handler(id); + + if (handler == NULL) { + croak("Invalid command id in removing a perl command handler.\n"); + return; + } + + gaim_cmd_unregister(id); + destroy_cmd_handler(handler); +} diff -r 7e45ccd91e58 -r e1603fd610fa plugins/perl/perl-handlers.h --- a/plugins/perl/perl-handlers.h Sun Jan 15 07:43:09 2006 +0000 +++ b/plugins/perl/perl-handlers.h Sun Jan 15 07:56:58 2006 +0000 @@ -1,19 +1,30 @@ #ifndef _GAIM_PERL_HANDLERS_H_ #define _GAIM_PERL_HANDLERS_H_ +#include "cmds.h" #include "plugin.h" #include "prefs.h" #include "pluginpref.h" #include "gtkplugin.h" #include "gtkutils.h" -/* TODO: Find a better way to access the perl names from the plugin prober */ -/* and store them for gaim_perl_plugin_action_* functions. */ +/* TODO: Find a better way to access the perl names from the plugin prober */ +/* and store them for gaim_perl_plugin_action_* functions. */ char * gaim_perl_plugin_action_callback_sub; char * gaim_perl_plugin_action_label; typedef struct { + GaimCmdId id; + SV *callback; + SV *data; + char *prpl_id; + char *cmd; + GaimPlugin *plugin; +} GaimPerlCmdHandler; + +typedef struct +{ SV *callback; SV *data; GaimPlugin *plugin; @@ -34,23 +45,28 @@ void gaim_perl_plugin_action_cb(GaimPluginAction * gpa); GList *gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context); -GaimPluginUiInfo *gaim_perl_plugin_pref(const char * frame_cb); GaimPluginPrefFrame *gaim_perl_get_plugin_frame(GaimPlugin *plugin); -GaimGtkPluginUiInfo *gaim_perl_gtk_plugin_pref(const char * frame_cb); GtkWidget *gaim_perl_gtk_get_plugin_frame(GaimPlugin *plugin); void gaim_perl_timeout_add(GaimPlugin *plugin, int seconds, SV *callback, - SV *data); + SV *data); void gaim_perl_timeout_clear_for_plugin(GaimPlugin *plugin); void gaim_perl_timeout_clear(void); void gaim_perl_signal_connect(GaimPlugin *plugin, void *instance, - const char *signal, SV *callback, - SV *data); + const char *signal, SV *callback, + SV *data); void gaim_perl_signal_disconnect(GaimPlugin *plugin, void *instance, - const char *signal); + const char *signal); void gaim_perl_signal_clear_for_plugin(GaimPlugin *plugin); void gaim_perl_signal_clear(void); +GaimCmdId gaim_perl_cmd_register(GaimPlugin *plugin, const gchar *cmd, + const gchar *args, GaimCmdPriority priority, + GaimCmdFlag flag, const gchar *prpl_id, + SV *callback, const gchar *helpstr, SV *data); +void gaim_perl_cmd_unregister(GaimCmdId id); +void gaim_perl_cmd_clear_for_plugin(GaimPlugin *plugin); + #endif /* _GAIM_PERL_HANDLERS_H_ */ diff -r 7e45ccd91e58 -r e1603fd610fa plugins/perl/perl.c --- a/plugins/perl/perl.c Sun Jan 15 07:43:09 2006 +0000 +++ b/plugins/perl/perl.c Sun Jan 15 07:56:58 2006 +0000 @@ -518,6 +518,7 @@ LEAVE; } + gaim_perl_cmd_clear_for_plugin(plugin); gaim_perl_signal_clear_for_plugin(plugin); gaim_perl_timeout_clear_for_plugin(plugin);