Mercurial > pidgin

changeset 12882:e1603fd610fa

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[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 <tailor@pidgin.im>
author Etan Reisner <pidgin@unreliablesource.net>
date Sun, 15 Jan 2006 07:56:58 +0000
parents 7e45ccd91e58
children d486bb706e82
files plugins/perl/common/Cmds.xs plugins/perl/common/Gaim.xs plugins/perl/common/module.h plugins/perl/common/typemap plugins/perl/perl-handlers.c plugins/perl/perl-handlers.h plugins/perl/perl.c
diffstat 7 files changed, 220 insertions(+), 34 deletions(-) [+]
line wrap: on
line diff
--- 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);
--- 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();
-
--- 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;
--- 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
--- 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);
+}
--- 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_ */
--- 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);