Mercurial > pidgin

--- a/plugins/perl/perl-common.h	Sun Jan 22 07:37:22 2006 +0000
+++ b/plugins/perl/perl-common.h	Sun Jan 22 10:29:34 2006 +0000
@@ -32,6 +32,7 @@
 	char *unload_sub;
 	char *prefs_sub;
 	char *gtk_prefs_sub;
+	char *plugin_action_sub;
 } GaimPerlScript;

 void gaim_perl_normalize_script_name(char *name);
--- a/plugins/perl/perl-handlers.c	Sun Jan 22 07:37:22 2006 +0000
+++ b/plugins/perl/perl-handlers.c	Sun Jan 22 10:29:34 2006 +0000
@@ -14,28 +14,38 @@
 #define PERL_MAGIC_ext '~'
 #endif

-/* For now a plugin can only have one action */
 void
-gaim_perl_plugin_action_cb(GaimPluginAction * gpa)
+gaim_perl_plugin_action_cb(GaimPluginAction *action)
 {
+	SV **callback;
+	HV *hv = NULL;
+	gchar *hvname;
+	GaimPlugin *plugin;
+	GaimPerlScript *gps;
 	dSP;
+
+	plugin = action->plugin;
+	gps = (GaimPerlScript *)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.", gaim_plugin_get_name(plugin));
+
 	ENTER;
 	SAVETMPS;
-	PUSHMARK(sp);
+
+	callback = hv_fetch(hv, action->label, strlen(action->label), 0);

-	/* We put the plugin handle on the stack so it can pass it along    */
-	/* to anything called from the callback.  It is supposed to pass    */
-	/* the Action, but there is no way to access the plugin handle from */
-	/* the GaimPluginAction in perl...yet.                              */
+	if (callback == NULL || *callback == NULL)
+		croak("No plugin_action function named \"%s\" in \"%s\" plugin.", action->label, gaim_plugin_get_name(plugin));

-	XPUSHs(gaim_perl_bless_object(gpa->plugin, "Gaim::Plugin"));
+	PUSHMARK(sp);
+	XPUSHs(gaim_perl_bless_object(gps->plugin, "Gaim::Plugin"));
 	PUTBACK;

-	/* gaim_perl_plugin_action_callback_sub defined in the header is set
-	 * in perl.c during plugin probe by a PLUGIN_INFO hash value limiting
-	 * us to only one action for right now even though the action member
-	 * of GaimPluginInfo can take (does take) a GList. */
-	call_pv(gaim_perl_plugin_action_callback_sub, G_EVAL | G_SCALAR);
+	call_sv(*callback, G_VOID | G_DISCARD);
 	SPAGAIN;

 	PUTBACK;
@@ -44,22 +54,53 @@
 }

 GList *
-gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context)
+gaim_perl_plugin_actions(GaimPlugin *plugin, gpointer context)
 {
-	GaimPluginAction *act = NULL;
-	GList *gl = NULL;
+	GList *l = NULL;
+	GaimPerlScript *gps;
+	int i = 0, count = 0;
+	dSP;
+
+	gps = (GaimPerlScript *)plugin->info->extra_info;
+
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(SP);
+	XPUSHs(sv_2mortal(gaim_perl_bless_object(plugin, "Gaim::Plugin")));
+	/* XXX This *will* cease working correctly if context gets changed to
+	 * ever be able to hold anything other than a GaimConnection */
+	if (context != NULL)
+		XPUSHs(sv_2mortal(gaim_perl_bless_object(context, "Gaim::Connection")));
+	else
+		XPUSHs(&PL_sv_undef);
+	PUTBACK;
+
+	count = call_pv(gps->plugin_action_sub, G_ARRAY);

-	/* TODO: Fix the way we create action handlers so we can have more
-	 * than one action in perl.  Maybe there is a clever work around, but
-	 * so far I have not figured it out.  There is no way to tie the perl
-	 * sub's name to the callback function without these global variables
-	 * and there is no way to create a callback on the fly so each would
-	 * have to be hardcoded--more than one would just be arbitrary. */
-	act = gaim_plugin_action_new(gaim_perl_plugin_action_label,
-	                             gaim_perl_plugin_action_cb);
-	gl = g_list_append(gl, act);
+	SPAGAIN;
+
+	if (count == 0)
+		croak("The plugin_actions sub didn't return anything.\n");
+
+	for (i = 0; i < count; i++) {
+		SV *sv;
+		gchar *label;
+		GaimPluginAction *act = NULL;

-	return gl;
+		sv = POPs;
+		label = SvPV_nolen(sv);
+		/* XXX I think this leaks, but doing it without the strdup
+		 * just showed garbage */
+		act = gaim_plugin_action_new(g_strdup(label), gaim_perl_plugin_action_cb);
+		l = g_list_append(l, act);
+	}
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+
+	return l;
 }

 GtkWidget *
--- a/plugins/perl/perl-handlers.h	Sun Jan 22 07:37:22 2006 +0000
+++ b/plugins/perl/perl-handlers.h	Sun Jan 22 10:29:34 2006 +0000
@@ -8,11 +8,6 @@
 #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.                 */
-char * gaim_perl_plugin_action_callback_sub;
-char * gaim_perl_plugin_action_label;
-
 typedef struct
 {
 	GaimCmdId id;
@@ -43,7 +38,7 @@
 } GaimPerlSignalHandler;

 void gaim_perl_plugin_action_cb(GaimPluginAction * gpa);
-GList *gaim_perl_plugin_action(GaimPlugin *plugin, gpointer context);
+GList *gaim_perl_plugin_actions(GaimPlugin *plugin, gpointer context);

 GaimPluginPrefFrame *gaim_perl_get_plugin_frame(GaimPlugin *plugin);
--- a/plugins/perl/perl.c	Sun Jan 22 07:37:22 2006 +0000
+++ b/plugins/perl/perl.c	Sun Jan 22 10:29:34 2006 +0000
@@ -376,28 +376,12 @@
 				info->ui_info = &gtk_ui_info;
 			}

-		/********************************************************/
-		/*                                                      */
-		/* plugin_action - This is given to the plugin info     */
-		/*                 as the action GList.  There are two  */
-		/*                 parts so the user can set the title  */
-		/*                 as it will appear in the plugin      */
-		/*                 action menu.  The name is extracted  */
-		/*                 and then the callback perl sub's     */
-		/*                 name both of which then are handled  */
-		/*                 by an internal gaim_perl function    */
-		/*                 that sets up the single cb function  */
-		/*                 which is then inserted into 'info'.  */
-		/********************************************************/
-			if ((key = hv_fetch(plugin_info, "plugin_action_label",
-			                    strlen("plugin_action_label"), 0))) {
-				gaim_perl_plugin_action_label = g_strdup(SvPV(*key, len));
-			}
-
-			if ((key = hv_fetch(plugin_info, "plugin_action",
-			                    strlen("plugin_action"), 0))) {
-				gaim_perl_plugin_action_callback_sub = g_strdup_printf("%s::%s", gps->package, SvPV(*key, len));
-				info->actions = gaim_perl_plugin_action;
+			if ((key = hv_fetch(plugin_info, "plugin_action_sub",
+			                    strlen("plugin_action_sub"), 0))) {
+				gps->plugin_action_sub = g_strdup_printf("%s::%s",
+				                                         gps->package,
+				                                         SvPV(*key, len));
+				info->actions = gaim_perl_plugin_actions;
 			}

 			plugin->info = info;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/plugins/perl/scripts/plugin_action.pl	Sun Jan 22 10:29:34 2006 +0000
@@ -0,0 +1,58 @@
+$MODULE_NAME = "Plugin Action Test Plugin";
+use Gaim;
+
+sub plugin_init {
+	return %PLUGIN_INFO;
+}
+
+sub plugin_load {
+	my $plugin = shift;
+}
+
+sub plugin_unload {
+	my $plugin = shift;
+}
+
+sub fun1 {
+	print "1\n";
+}
+
+sub fun2 {
+	print "2\n";
+}
+
+sub fun3 {
+	print "3\n";
+}
+
+%plugin_actions = (
+	"Action 1" => \&fun1,
+	"Action 2" => \&fun2,
+	"Action 3" => \&fun3
+#	"Action 1" => sub { print "1\n"; },
+#	"Action 2" => sub { print "2\n"; },
+#	"Action 3" => sub { print "3\n"; }
+);
+
+sub plugin_action_names {
+	foreach $key (keys %plugin_actions) {
+		push @array, $key;
+	}
+
+	return @array;
+}
+
+# All the information Gaim gets about our nifty plugin
+%PLUGIN_INFO = (
+	perl_api_version => 2,
+	name => "Perl: $MODULE_NAME",
+	version => "0.1",
+	summary => "Test plugin for the Perl interpreter.",
+	description => "Just a basic test plugin template.",
+	author => "Etan Reisner <deryni\@gmail.com>",
+	url => "http://sourceforge.net/users/deryni9/",
+
+	load => "plugin_load",
+	unload => "plugin_unload",
+	plugin_action_sub => "plugin_action_names"
+);