diff plugins/perl/perl-handlers.c @ 12988:b457aa723bab

[gaim-migrate @ 15341] Perl plugins can now have more than one plugin action. This isn't exactly the nicest way to have done this, as it requires a "global" plugin_actions hash to work, but I couldn't get the cleaner way to work and this is better than nothing. committer: Tailor Script <tailor@pidgin.im>
author Etan Reisner <pidgin@unreliablesource.net>
date Sun, 22 Jan 2006 10:29:34 +0000
parents e1603fd610fa
children 7fdd1c0c585c
line wrap: on
line diff
--- 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 *